Оригинальный DVD-ROM: eXeL@B DVD !
eXeL@B ВИДЕОКУРС !

ВИДЕОКУРС
выпущен 4 ноября!


УЗНАТЬ БОЛЬШЕ >>
Домой | Статьи | RAR-cтатьи | FAQ | Форум | Скачать | Видеокурс
Новичку | Ссылки | Программирование | Интервью | Архив | Связь

БОЛЬШОЙ FAQ ПО DELPHI



Как запустить приложение и подождать пока оно отработает

Объявляем сначала две глобальные переменные:


 var
   si: Tstartupinfo;
   p: Tprocessinformation;
 

Затем по нужному событию, например, по нажатию на кнопке пишет такой код:


 FillChar( Si, SizeOf( Si ) , 0 );
 with Si do
 begin
   cb := SizeOf( Si);
   dwFlags := startf_UseShowWindow;
   wShowWindow := 4;
 end;
 
 Form1.WindowState:=wsminimized;
 Createprocess(nil, 'c:\windows\sndrec32.exe e:\temp.wav', nil, nil,
 false, Create_default_error_mode, nil, nil, si, p);
 Waitforsingleobject(p.hProcess, infinite);
 Form1.WindowState:=wsNormal;
 




Как запустить приложение и подождать пока оно отработает 2


 procedure TForm1.Button3Click(Sender: TObject);
 var
   si: STARTUPINFO;
   pi: PROCESS_INFORMATION;
   cmdline: string;
 begin
   ZeroMemory(@si,sizeof(si));
   si.cb:=SizeOf(si);
   cmdline:='c:\command.com';
   if not CreateProcess( nil, { No module name (use command line). }
   PChar(cmdline),            { Command line. }
   nil,                       { Process handle not inheritable. }
   nil,                       { Thread handle not inheritable. }
   False,                     { Set handle inheritance to FALSE. }
   0,                         { No creation flags. }
   nil,                       { Use parent's environment block. }
   nil,                       { Use parent's starting directory. }
   si,                        { Pointer to STARTUPINFO structure. }
   pi )                       { Pointer to PROCESS_INFORMATION structure. }
   then
   begin
   ShowMessage( 'CreateProcess failed.' );
   Exit;
   end;
   WaitForSingleObject( pi.hProcess, INFINITE );
   CloseHandle( pi.hProcess );
   CloseHandle( pi.hThread );
   ShowMessage('Done !');
 end;
 




Как запустить приложение и подождать пока оно отработает 3

Здесь представлена функция, которая вызывается таким же образом как и WinExec, однако она ждёт, пока запущенная задача завершится.


 function WinExecAndWait(Path: PChar; Visibility: Word): Word;
 var
   InstanceID: THandle;
   Msg: TMsg;
 begin
   InstanceID := WinExec(Path, Visibility);
   if InstanceID < 32 then { значение меньше чем 32 указывает на ошибку }
     WinExecAndWait := InstanceID
   else
     repeat
       while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
       begin
         if Msg.message = wm_Quit then
           Halt(Msg.WParam);
         TranslateMessage(Msg);
         DispatchMessage(Msg);
       end;
     until
       GetModuleUsage(InstanceID) = 0;
   WinExecAndWait := 0;
 end;
 




Как запустить приложение и подождать пока оно отработает 4

как запустить из Вашей программы еще какую-нибудь программу и дождаться ее закрытия. Для удобства сразу оговорюсь: Ваша программа - это программа, код которой здесь приведен. Другая программа - программа, которая была запущена из Вашей. Для запуска другой программы мы будем использовать функцию CreateProcess, поскольку она возвращает handle созданного процесса. Для ожидания завершения процесса (программы) нужно вызвать Wai В этом примере функция ExecuteAndWait запускает другую программу (имя запускаемого файла - FileName). Если HideApplication установлен в true, то Ваша программа исчезает на время выполнения другой программы. В противном случае Ваша программа остается на экране и каждые 0.1 сек. будут выполняться все задачи, которые накопились в очереди (Application.ProcessMessages). А если пользователь решит закрыть Вашу программу - закроется и другая программа. Процедура SetEnabled


 function ExecuteAndWait(FileName: string; HideApplication: boolean): boolean;
 var
   StartupInfo: TStartupInfo;
   ProcessInfo: TProcessInformation;
   exitc: cardinal;
 begin
   FillChar(StartupInfo, sizeof(StartupInfo), 0);
   with StartupInfo do begin
     cb := Sizeof(StartupInfo);
     dwFlags := STARTF_USESHOWWINDOW;
     wShowWindow := SW_SHOW;
   end;
   if not CreateProcess(nil, PChar(FileName), nil, nil, false,
     CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
     StartupInfo, ProcessInfo) then result := false
   else begin
     if HideApplication then begin
       Application.Minimize;
       ShowWindow(Application.Handle, SW_HIDE);
       WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
     end else
       while WaitforSingleObject(ProcessInfo.hProcess, 100) =
         WAIT_TIMEOUT do begin
         Application.ProcessMessages;
         if Application.Terminated
           then TerminateProcess(ProcessInfo.hProcess, 0);
       end;
     GetExitCodeProcess(ProcessInfo.hProcess, exitc);
     result := (exitc = 0);
     if HideApplication then begin
       ShowWindow(Application.Handle, SW_SHOW);
       Application.Restore;
       Application.BringToFront;
     end;
   end;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
   procedure SetEnabled(en: boolean);
   var
     i: integer;
   begin
     for i := 0 to Form1.ComponentCount - 1 do
       if Form1.Components[i] is TControl then
         (Form1.Components[i] as TControl).Enabled := en;
   end;
 begin
   SetEnabled(false);
   if not ExecuteAndWait(Edit1.Text, CheckBox1.Checked)
     then ShowMessage('Возникли какие-то проблемы');
   SetEnabled(true);
 end;
 




Как запустить приложение и подождать пока оно отработает 5

Автор: Robor

Запускаю с помощью CreateProcess процесс архивирования, как узнать, что он завершился, чтобы перекопировать файл на дискету?


 Unit exec;
 
 interface
 
 Uses Windows, SysUtils, Forms, ShellAPI;
 
 function ExecWin(Path,name,CommandLine,CurrentDir:string;Wait:boolean) : word;
 
 implementation
 
 function ExecWin(Path,name,CommandLine,CurrentDir:string;Wait:boolean) : word;
 var
  tsi           : TStartupInfo;
  tpi           : TProcessInformation;
  tPath,Command : PChar;
  CurDir        :Pchar;
 //  st1           :string;
 //  T1,T2,T3,T4   :TFileTime;
 //  rr            :boolean;
  cod           :DWord;
 
 //  ErrorMessage: Pointer;  
 //  ErrorCode: DWORD;           // holds a system error code
 begin
  Result := 30;
  Path:=path+name+' '+CommandLine+#00;
  CommandLine:=CommandLine+#0;
  tPath   := StrAlloc(512);
  Command := StrAlloc(512);
  CurDir  :=StrAlloc(512);
 
  FillChar(tsi, SizeOf(TStartupInfo), 0);
  tsi.cb := SizeOf(TStartupInfo);
  tsi.dwFlags := STARTF_USESHOWWINDOW;
  tsi.wShowWindow := SW_SHOWMINNOACTIVE;
 //  FindExecutable(@Path[1],nil,tPath);
 //  st1:=string(tPath)+#0;
 //  st1:=AnsiUpperCase(st1);
 //  Path:=AnsiUpperCase(Path);
 //  if st1< > Path then st1:=Concat(st1,' ',path,#0);
 //  Move(st1[1],tPath[0],Length(st1));
 //  Move(CommandLine[1],Command[0],length(CommandLine));
  Move(Path[1],tPath[0],Length(Path));
  CurrentDir:=CurrentDir+#0;
  Move(CurrentDir[1],CurDir[0],length(CurrentDir));
  try
    if CreateProcess(nil,@tPath[0]{, @Command[0]},nil, nil, False,
    CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,nil, @CurDir[0], tsi, tpi)
     then begin
       cod:=WAIT_TIMEOUT;
       while (cod=WAIT_TIMEOUT) and Wait do begin
         cod:=WaitForSingleObject(tpi.hProcess, 500);
         Application.ProcessMessages;
       end;
       result:=0;
 {       rr:=GetProcessTimes(tpi.hProcess,t1,t2,t3,t4);
       while (t2.dwLowDateTime=0) and (t2.dwHighDateTime=0) and rr do begin
        Application.ProcessMessages;
        rr:=GetProcessTimes(tpi.hProcess,t1,t2,t3,t4);
       end;}
       CloseHandle(tpi.hProcess);
       CloseHandle(tpi.hThread);
     end
     else result:=GetLastError;
  finally
 {  ErrorCode := GetLastError;
  FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
                nil, ErrorCode, 0, @ErrorMessage, 0, nil);
  LocalFree(hlocal(ErrorMessage));}
  StrDispose(Command);
  StrDispose(tPath);
  StrDispose(CurDir);
  end;
 end;
 
 end.
 




Как запустить приложение и подождать пока оно отработает 6


 procedure Start;
 var
   si: TStartupInfo;
   p:  TProcessInformation;
 begin
   FillChar(Si,SizeOf(Si),0);
   with Si do begin
     cb := SizeOf( Si);
     dwFlags := startf_UseShowWindow;
     wShowWindow := 4;
   end;
   Form1.WindowState:=wsMinimized;
   Createprocess(nil,'c:\windows\sndrec32.exe e:/temp.wav',nil,nil,false,
         Create_default_error_mode,nil,nil,si);
   Waitforsingleobject(p.hProcess,infinite);
   Form1.WindowState:=wsNormal;
 end;
 




Определение нажатия определенной клавиши во время загрузки приложения

Билл Гейтс собирает правление Майкрософт.
- в прошлом году мы продали 1 миллион копий Виндоус...
- хакеры сломали.
- в этом году мы продали 2 миллиона копий.
- хакеры сломали.
- в следующем году мы продадим 5 миллионов копий...
- и пусть у этих хакеров клавиатура треснет!


 program Project1;
 
 uses
   Windows,
   Forms,
   Unit1 in 'Unit1.pas' {Form1};
 
 {$R *.RES}
 
 begin
   if GetKeyState(vk_F8) < 1 then
     MessageBox(0, 'F8 was pressed during startup', 'MyApp', mb_ok);
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
 end.
 




Как поместить программу в автозапуск

Это можно сделать несколькими способами, но наиболее оптимальный - занесение файла в автозапуск реестра, который находится по следующему адресу:


 HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run
 


 uses Registry;
 
 procedure TForm1.FormCreate(Sender: TObject);
 var
   // Переменная реестра
   h: TRegistry;
 begin
   h := TRegistry.Create;
   with h do
   begin
     RootKey := HKEY_LOCAL_MACHINE;
     OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', true);
     WriteString('DelphiWorldApp', 'C:\Application.exe');
     CloseKey;
     Free;
   end;
 end;
 




Как поместить приложение Delphi в Панель Управления

Для использования апплета измените его расширение с "dll" на "cpl" и поместите в системную директорию.


 library Project1; {Измените "program" на "library"}
 
 uses
   Cpl, {используем модуль Cpl}
   Windows,
   Forms,
   Unit1 in 'Unit1.pas' {Form1};
 
 {$R *.RES}
 
 procedure ExecuteApp;
 begin
   Application.Initialize;
   Application.CreateForm(TForm1, Form1);
   Application.Run;
 end;
 
 {Сallback-функция для экспорта в Панель Управления}
 
 function CPlApplet(hwndCPl: THandle; uMsg: DWORD;
   lParam1, lParam2: LongInt): LongInt; stdcall;
 var
   NewCplInfo: PNewCplInfo;
 begin
   Result := 0;
   case uMsg of
     {Инициализация должна возвращать True.}
     CPL_INIT:
       Result := 1;
     {Число апплетов}
     CPL_GETCOUNT:
       Result := 1;
     {Помещаем информацию об этом апплете в Панель управления.}
     CPL_NEWINQUIRE:
       begin
         NewCplInfo := PNewCplInfo(lParam2);
         with NewCplInfo^ do
         begin
           dwSize := SizeOf(TNewCplInfo);
           dwFlags := 0;
           dwHelpContext := 0;
           lData := 0;
           {Иконка для отображения на Панели Управления.}
           hIcon := LoadIcon(HInstance, 'MAINICON');
           {Имя апплета}
           szName := 'Project1';
           {Описание этого апплета.}
           szInfo := 'Это тестовый апплет.';
           szHelpFile := '';
         end;
       end;
     {Выполнение апплета.}
     CPL_DBLCLK:
       ExecuteApp;
   else
     Result := 0;
   end;
 end;
 
 {Экспортирование функции CplApplet}
 exports
   CPlApplet;
 begin
 
 end.
 




Программа с многоязычным интерфейсом

Hа уроке классической литературы. Учительница:
- Кто может привести пример языка, на котором никто сегодня не говорит, но который является фундаментом других языков?
Вовочка:
- HТМL.

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

Для начала немного теории

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

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

Большую популярность получили программы с многоязычным интерфейсом. Я имею в виду, что описанные выше программы получают большую популярность, чем аналогичные с однотипным диалоговым языком. К примеру, это некоторые командные оболочки (FAR, Windows Commander), антивирус DrWeb, интернет броузер Opera. В таких программах нужный язык можно выбрать из списка в окнах настройки.

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

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

Различные секции в таком ini-файле будут хранить в себе отдельные языковые интерфейсы. Например, секция [RUSSIAN] будет озаглавливать русскоязычный внешний вид программы, [ENGLISH] - англоязычный, и т.д. Я думаю, что с этим проблем у пользователя не будет.

Названия хранимых параметров состоят из названия окна (формы), в котором находится компонент плюс название самого компонента. Параметр должен состоять из одного слова. Хранимая величина - текст, который отображается на экране на этом компоненте. Это может быть свойство Caption или свойство Text, в зависимости от типа (класс) компонента. Например, для компонента Button1, находящегося в окне Form1 записываемый параметр и значение выглядит:


 Form1Button1=Кнопка1
 

В нашей программе при чтении такого параметра должна произойти замена:


 Form1.Button1.Caption := 'Кнопка1';
 

Естественно, это делается автоматически для всех визуальных компонентов, на каких есть текст. Проблема может состоять в том, что таких компонентов на каждой форме может быть, скажем 200. Тогда это очень загромоздит программный код. При оперативном исправлении такой программы (добавление, удаление компонентов), необходимо будет исправлять и эту часть кода. Выходом из создавшейся проблемы может быть свойства для определенного окна ComponentCount и Components. Свойство Components позволяет через массив получить доступ к любому элементу управления формы. Свойтсво ComponentCount показывает, сколько этих элементов управления (компонентов) у нас присутствует в окне. Нам нужно будет просто организовать цикл от 1 до ComponentsCount и для каждого компонента прочитать соответствующее значение Caption или Text из INI файла.

Внутри такого цикла нужно определять тип компонента. Ведь для кнопки (Button, BitBtn, SpeedButton), метки (Label, StaticText), флажка (CheckBox, RadioButton) и пр. свойство Caption определяет текст, который будет виден на этом компоненте. Для Edit, Memo, ComboBox и пр. свойтсво Text. Следовательно, очень важно верно определить тип, выбранного из цикла компонента, чтобы в последствии правильно занести соответствующее значение в соответствующее свойство.

Следующим этапом, когда мы определили тип компонента, следует само чтение данных из ini-файла. Вот примерный кусок кода такой программы:


 // если в окне есть хотя бы один элемент управления (компонент)
 if ComponentCount<>0 then
   // цикл от 1 до кол-ва компонентов
   for i:=1 to ComponentCount do
     // если текущий элемент является элементом класса TButton, то
     if Components[i-1].ClassType = TButton then
       (Components[i-1] as TButton).Caption:= ЧТЕНИЕ_ДАННЫХ_ИЗ_INI
 

Разъясню последнюю строчку из этого примера. Через


 (Components[i-1] as TButton)
 

Мы получаем доступ к свойствам компонента, представляя его к классу TButton. Для этого в предпоследней строке примера мы и производим проверку класса выбранного циклом компонента. Если такую проверку не производить, то во время выполнения программы при обращении, скажем к компоненту класса TEdit к свойству Caption, появится сообщение об ошибке (У TEdit свойство Text!).

(i-1) как вы наверное уже догадались, список массива элементов управления формы начинается с нуля. А заканчивается ComponentCount-1.

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

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

В раздел Uses необходимо дописать модуль для работы с ini-файлами:


 uses IniFiles;
 

Раздел public дописываем одну строку объявления процедуры:


 public
   { Public declarations }
   procedure ChangeLang(LangSection: string);
 

Сама процедура пишется изначально вручную вместе с заголовком:


 procedure TForm1.ChangeLang(LangSection: string);
 var
   // временная числовая переменная для выборки всех компонентов
   i: Integer;
   LangIniFile: TIniFile;
   // строковая переменная для получения каталога, где находится запущенный EXE файл
   ProgramPath: string;
 begin
   // если в окне больше одного компонента
   if ComponentCount <> 0 then
   begin
     // получаем каталог, где лежит запущенный EXE файл
     ProgramPath := ExtractFileDir(Application.ExeName);
     // гарантированно устанавливаем последний символ '\' в конце строки
     if ProgramPath[Length(ProgramPath)] <> '\' then
       ProgramPath := ProgramPath + '\';
     // подготавливаем INI файл. Он должен иметь название lang.ini
     // и должен находиться в каталоге программы
     LangIniFile:=TIniFile.Create(ProgramPath+'lang.ini');
     // читаем заголовок окна
     Caption:=LangIniFile.ReadString(LangSection,name,Caption);
     // перебираем все компоненты в этом окне
     for i:=1 to ComponentCount do
     begin
       // если выбран из массива компонент Button, то изменяем текст на кнопке
       if Components[i-1].ClassType = TButton then
         (Components[i-1] as TButton).Caption := LangIniFile.ReadString(LangSection,
         name+Components[i-1].name, (Components[i-1] as TButton).Caption);
 
       // Напомню описание функции ReadString:
       // ====================================
       // LangIniFile.ReadString( СЕКЦИЯ, ПАРАМЕТР, ЗНАЧЕНИЕ_ПО_УМОЛЧАНИЮ );
       // 1. LangSection - передаваемый параметр в процедуру.
       //    В процедуру передается название секции для выбранного языка
       // 2. Name+Components[i-1].Name - Name - название формы,
       //    Components[i-1].Name - название компонента
       // 3. (Components[i-1] as TButton).Caption - в случае неудачного чтения этого
       //    параметра из ini файла (нет такого параметра), то ничего меняться не будет
 
       // аналогично для других типов:
       if Components[i-1].ClassType = TLabel then
         (Components[i-1] as TLabel).Caption := LangIniFile.ReadString(LangSection,
         name+Components[i-1].name, (Components[i-1] as TLabel).Caption);
       if Components[i-1].ClassType = TEdit then
         (Components[i-1] as TEdit).Text := LangIniFile.ReadString(LangSection,
         name+Components[i-1].name, (Components[i-1] as TEdit).Text);
     // ...
     // ...
     // ...
     end;
     LangIniFile.Free; // освобождаем ресурс
   end;
 end;
 

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

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

Напомню, аналогичную вышеприведенную процедуру, без изменений, вы должны вписать в каждый модуль вашей программы. При смене языка, например, в программе с тремя окнами (Form1, Form2, Form3) происходит следующим куском программного кода:


 Form1.ChangeLang('RUSSIAN');
 Form2.ChangeLang('RUSSIAN');
 Form3.ChangeLang('RUSSIAN');
 

Поскольку процедуру смена языка мы объявляем в разделе public, то доступ к этой процедуре мы можем получить из любого места программы. Как вы заметили из примера, для переключения на русский язык указана имя секции RUSSIAN.

Теперь рассмотрим содержание самого INI файла. Его вы должны создавать самостоятельно. Во-первых, нужно помнить правила орфографии windows ini-файла, во-вторых, названия параметров должны соответствовать имени формы плюс названия компонента, хранимое значение следует за знаком равенства. Для примера, ini-файл с двумя языками, с двумя окнами, на каждом окне находится по две кнопки.


 ; начало файла lang.ini
 [RUSSIAN]
 Form1Button1=Кнопка 1 на форме 1
 Form1Button2=Кнопка 2 на форме 1
 Form2Button1=Кнопка 1 на форме 2
 Form2Button2=Кнопка 2 на форме 2
 
 [ENGLISH]
 Form1Button1=Button 1 on form 1
 Form1Button2=Button 2 on form 1
 Form2Button1=Button 1 on form 2
 Form2Button2=Button 2 on form 2
 ; конец файла lang.ini
 

Кроме текста на визуальных элементах управления вашей программы, текст содержится еще в заголовке программы, в панели задач. Еще могут присутствовать всплывающие подсказки Hint. Полномасштабный перевод всех компонентов на несколько языков в ini файле может несколько затруднить сам процесс программирования. Но ради гибкости настройки интерфейса программы пожертвовуйте лишним временем. Ведь для изменения текста, добавления нового языка (возможно даже это делаете не вы) не нужно перекомпилировать проект. Это максимально упрощает языковую настройку. Можете вообще сделать ini-файл одноязычным. Перевести его можете после окончания проектирования, или вообще предоставьте это профессиональному переводчику.

Одним из слабых мест в такой программе есть необходимость помещать процедуру смены языка в каждый модуль. Если у вас в программе множество окон, это довольно сильно загромождает программный код, следовательно, увеличивает размер программы, следовательно, замедляет ее работу. Как же сделать так, чтобы весь процесс смены языка во всем приложении умещался с одной процедуре. Очень просто. А может и не просто. А в общем, через компонент Application. Он является по своей сути самой программой, значит, содержит в себе все компоненты форм (уже упоминалось в первых уроках, что сама форма и есть компонент). Таким образом:


 // если в приложении есть компоненты форм (не консольное приложение)
 if Application.ComponentCount <> 0 then
   // перебираем все компоненты
   for i := 1 to Application.ComponentCount do
     // если выбранный компонент является подклассом окна, то
     if Application.Components[i-1].ClassParent = TForm then
     begin
       // обработка переключения языка для этого окна
     end;
 

Очень похоже на предыдущий пример...

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

Опять ищем слабые места в программе. Для начинающих программистов может быть новостью, что в одной программе не может быть двух и более окон с одинаковыми названиями. А как же дело обстоит с MDI приложениями. Дочернее окно проектируется в единственном варианте, а в внутри родительской формы, во время работы программы, оно может создаваться теоретически в неограниченном количестве. Имена же самой вновь создаваемой дочерней форме присваиваются системой автоматически. Следовательно, читать параметр из ini-файла по свойству Name не подойдет. Таким методом можно максимально прочитать язык для компонентов только для одного дочернего MDI-окна. Отсюда следует, что нужно читать данные согласно свойству ClassName, которое является уникальным для отдельного класса окна. Например, для окна Form1, являющегося главным MDI-окном такой класс TForm1. Для окна Form2, дочернего MDI-окна класс TForm2. Вот, вы наконец и узнали, что же это за такая туква Т, стоящая в начале названия компонента. Это надкласс, объединяющий однотипные компоненты (в том числе и окно программы) в единую группу, с одинаковыми вложенными свойствами. Это краткое описание, можно сказать, своими словами.

Эти все "наваяния" организованы во втором примере. Там смена языка происходит из одной процедуры абсолютно для всех окон. Тем самым мы уменьшили программный код за счет увеличения качества, увеличили количество вложенных циклов. Программа примера номер 2 является незаконченным каркасом MDI-приложения. Не удивляйтесь, почему программа не выполняет функции редактора.

Оъявление. Автор уроков для начинающих по delphi ищет темы, какие вам было бы интересно узнать. Свои предложения отсылайте мне, Semen'у, по адресу mailto:semen@krovatka.net?subject=предложение, указав в теме письма слово "предложение". Ваше предложение не должно быть очень сложным для программного решения, понятным для начинающего, тема не должна отклоняться от тематики ведения уроков (например, не рассматривается управление базами данных, SQL, internet и пр.). Материал, написанный по вашему предложению, ориентировочно должен быть дан в объеме одного урока. Предложение в текущий урок должно быть отправлено до пятницы.

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




Проверить эквивалентность двух файлов


 function Are2FilesEqual(const File1, File2: TFileName): Boolean;
 var
   ms1, ms2: TMemoryStream;
 begin
   Result := False;
   ms1 := TMemoryStream.Create;
   try
     ms1.LoadFromFile(File1);
     ms2 := TMemoryStream.Create;
     try
       ms2.LoadFromFile(File2);
       if ms1.Size = ms2.Size then
         Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);
     finally
       ms2.Free;
     end;
   finally
     ms1.Free;
   end
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   if Opendialog1.Execute then
     if Opendialog2.Execute then
       if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then
         ShowMessage('Files are equal.');
 end;
 
 {********************************************}
 
 {2.}
 
 function FilesAreEqual(const File1, File2: TFileName): Boolean;
 const
   BlockSize = 65536;
 var
   fs1, fs2: TFileStream;
   L1, L2: Integer;
   B1, B2: array[1..BlockSize] of Byte;
 begin
   Result := False;
   fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);
   try
     fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);
     try
       if fs1.Size = fs2.Size then
       begin
         while fs1.Position < fs1.Size do
         begin
           L1 := fs1.Read(B1[1], BlockSize);
           L2 := fs2.Read(B2[1], BlockSize);
           if L1 <> L2 then
           begin
             Exit;
           end;
           if not CompareMem(@B1[1], @B2[1], L1) then Exit;
         end;
         Result := True;
       end;
     finally
       fs2.Free;
     end;
   finally
     fs1.Free;
   end;
 end;
 




Арифметика указателей

Вы можете рассказать об арифметике указателей в Delphi?

Сначала короткое объяснение арифметике указателя. Когда вы имеете дело с динамическими страницами памяти, то все, что вы имеете - это указатели на начала блоков памяти. Вы хотите просмотреть всю строку памяти, чтобы понять какие функции необходимы для работы с данными, хранящимися в памяти? Это возможно путем изменения места в памяти, на которое указывает указатель. Это называется арифметикой указателя.

Основополагающая идея при занятиях арифметикой с указателем - указатель должен быть увеличен на значение корректного приращения. (Корректное приращение определяется размером объекта, на который показывает указатель. Например, char = 1 байт; integer = 2 байта; double = 8 байт и т.д.) Функции Inc() и Dec() изменяют значение корректного приращения. (Компилятор знает правильный размер объекта.)

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


 uses WinCRT;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   MyArray: array[0..30] of char;
   b: ^char;
   i: integer;
 begin
   StrCopy(MyArray, 'Дельфи - рулез фарева!');
     {помещаем что-то в память для организации указателя}
   b := @MyArray; { назначаем указатель на текущую позицию памяти }
   for i := StrLen(MyArray) downto 0 do
   begin
     write(b^); { пишем символ в текущую позицию указателя. }
     inc(b); { перемещаем указатель на следующий байт памяти }
   end;
 end;
 

Нижеследующий код демонстрирует работу функций Inc() и Dec(), увеличивающих или уменьшающих указатель на размер соответствующего типа:


 var
   P1, P2: ^LongInt;
   L: LongInt;
 begin
   P1 := @L; { назначаем оба указателя на одно и то же место }
   P2 := @L;
   Inc(P2); { Увеличиваем один }
 
   { Здесь мы получаем разницу между смещениями двух
   указателей. Поскольку первоначально они указывали на одно
   и то же место памяти, то результатом данного вызова
   будет разница между двумя указателями после вызова Inc(). }
 
   L := Ofs(P2^) - Ofs(P1^); { L = 4; т.е. sizeof(longInt) }
 end;
 

Вы можете изменить тип объекта, на который указывает P1 и P2, на какой-то другой и убедиться, что (SizeOf(P1^)) всегда возвращает величину корректного приращения (проще сказать, что это размер объекта - В.О.).




Armadillo и CopyMem II

Автор: Hex

Я не люблю всякие анпакеры, потому что они приучают лениться. А потом автор анпакера пропадет куда-нить и все - фиг чего-то сделаешь. Т.к. не знаешь как оно работает. Вот и к анпакеру Armkiller у меня такое же отношение. Поэтому опишу как ловить армадилину раскриптовку при CopyMem II.

Для тех кто в танке:

Armadillo работает так: запускает себя в двух экземплярах.

1) Этот тот что вызвали мы. Это типа сервер
2) Созданный серевером. (клиент)

Так вот сервер запускает клиента в режиме отладки и помере происходящих DebugEvents он его разжимает, делает импорт и т.д. и потом запускает. CopyMem II: это такая фича у сервера. Когда она включена сервер динамически раскриптовывает секцию кода клиента блоками по 1000h байт. После выполненния кода этой страницы - закриптовывает назад. Т.е. сервер следит за Page Fault. И когда оно происходит - раскриптовывает недостающий блок и ставит все на место. Так вот, наша цель: заставить сервер распаковать прогу полностью и больше не закриптовывать.

Инструменты: Softice, IDA.

Для примера беру сам Armadillo 2.61 Public build 2000. Он является последним к моменту написания статьи и в нем используется CopyMem II.

Загружаем Armadillo 2.61 в IDA пусть дизасмится. Запускаем армадилу жмем Basic и больше никуда не лезем. Теперь ставим bpx Writeprocessmemory и жмем "Protection" - "Edit Project". Вылезет айс. Делаем bd * и жмем 3 раза F12. Видим вот это (я тут уже поподписывал):


 _text1:0044D6BD push 0 ; EnCryptBit - если 1 - закриптовать, 0 - раскриптовать
 _text1:0044D6BF mov esi, [ebp+PageNumber]
 _text1:0044D6C5 shl esi, 4
 _text1:0044D6C8 mov eax, [ebp+PageNumber]
 _text1:0044D6CE and eax, 80000007h
 _text1:0044D6D3 jns short loc_0_44D6DA
 _text1:0044D6D5 dec eax
 _text1:0044D6D6 or eax, 0FFFFFFF8h
 _text1:0044D6D9 inc eax
 _text1:0044D6DA
 _text1:0044D6DA loc_0_44D6DA: ; CODE XREF: sub_0_44C5FD+10D6j
 _text1:0044D6DA xor ecx, ecx
 _text1:0044D6DC mov cl, byte ptr ds:unk_0_4591E0[eax]
 _text1:0044D6E2 mov edx, [ebp+PageNumber]
 _text1:0044D6E8 and edx, 80000007h
 _text1:0044D6EE jns short loc_0_44D6F5
 _text1:0044D6F0 dec edx
 _text1:0044D6F1 or edx, 0FFFFFFF8h
 _text1:0044D6F4 inc edx
 _text1:0044D6F5
 _text1:0044D6F5 loc_0_44D6F5: ; CODE XREF: sub_0_44C5FD+10F1j
 _text1:0044D6F5 xor eax, eax
 _text1:0044D6F7 mov al, byte ptr ds:unk_0_4591E1[edx]
 _text1:0044D6FD mov edi, ds:dword_0_456238[ecx*4]
 _text1:0044D704 xor edi, ds:dword_0_456238[eax*4]
 _text1:0044D70B mov ecx, [ebp+PageNumber]
 _text1:0044D711 and ecx, 80000007h
 _text1:0044D717 jns short loc_0_44D71E
 _text1:0044D719 dec ecx
 _text1:0044D71A or ecx, 0FFFFFFF8h
 _text1:0044D71D inc ecx
 _text1:0044D71E
 _text1:0044D71E loc_0_44D71E: ; CODE XREF: sub_0_44C5FD+111Aj
 _text1:0044D71E xor edx, edx
 _text1:0044D720 mov dl, byte ptr ds:unk_0_4591E2[ecx]
 _text1:0044D726 xor edi, ds:dword_0_456238[edx*4]
 _text1:0044D72D mov eax, [ebp+PageNumber]
 _text1:0044D733 cdq
 _text1:0044D734 mov ecx, 1Ch
 _text1:0044D739 idiv ecx
 _text1:0044D73B mov ecx, edx
 _text1:0044D73D shr edi, cl
 _text1:0044D73F and edi, 0Fh
 _text1:0044D742 add esi, edi
 _text1:0044D744
 _text1:0044D744 DeCrypting:
 _text1:0044D744 mov edx, ds:dword_0_459A74
 _text1:0044D74A lea eax, [edx+esi*4]
 _text1:0044D74D push eax ; hHash
 _text1:0044D74E mov ecx, [ebp+PageNumber]
 _text1:0044D754 push ecx ; PageNumber - номер страницы для раскриптовки.
 _text1:0044D755 call ArmaCryptDecrypt
 _text1:0044D75A add esp, 0Ch
 _text1:0044D75D and eax, 0FFh
 _text1:0044D762 test eax, eax
 _text1:0044D764 jz short loc_0_44D770
 

Все что идет от _text1:0044D6BF до _text1:0044D74D - это просто вычисление кодов для раскриптовки указаной страницы. Чтобы раскриптовать нужную страницу нужно после выполнения _text1:0044D75A add esp, 0Ch загнать в [ebp+PageNumber] номер нужной страницы и прыгнуть к _text1:0044D6BD push 0 Таким образом можно прямо в айсе написать небольшой цикл который раскриптует все страницы. Как используются номера страниц? Номер страницы*1000+401000 = адрес, куда будет записан раскриптованый кусок. Таким образом чтобы узнать сколько у нас страниц смотрим в PE: Rva секции .text = 1000, Rva следующей секции(.rdata) = 2A000 т.е. число страниц = ((2A000 - 1000 ) / 1000) - 1 = 28h штук (-1 это я опытным путем выявил :) Но перед тем как писать цикл такой нужно обратить внимание еще на 1 особенность. Внутри ArmaCryptDecrypt есть еще 2 разных вызова одной и той же процедуры:

Раз:


 _text1:0044E3FF push 0 ; Decrypt...
 _text1:0044E401 mov ecx, [ebp+hHash]
 _text1:0044E404 push ecx
 _text1:0044E405 mov edx, [ebp+PageNumber]
 _text1:0044E408 push edx
 _text1:0044E409 call Crypting
 _text1:0044E40E add esp, 0Ch
 

Два:


 _text1:0044E48F push 1 ; Crypt...
 ...............
 _text1:0044E542 mov edx, ds:dword_0_459A74
 _text1:0044E548 lea eax, [edx+esi*4]
 _text1:0044E54B push eax ; Crypting...
 _text1:0044E54C mov ecx, ds:dword_0_459A88
 _text1:0044E552 mov edx, ds:dword_0_459A8C
 _text1:0044E558 mov eax, [edx+ecx*4]
 _text1:0044E55B push eax
 _text1:0044E55C call Crypting
 _text1:0044E561 add esp, 0Ch
 

Первая всегда раскриптовывает, а вторая закриптовывает и удаляет страницу из памяти (т.е. ставит No_access) Нам на удаление страниц совсем не нужно, поэтому оставим только первый вызов, а второй CALL происходит если _text1:0044E47C jle loc_0_44E57C не прыгает.

Таким образом чтоб раскриптовать секцию кода нужно пропатчить _text1:0044E47C jle loc_0_44E57C на _text1:0044E47C jmp loc_0_44E57C И сделать цикл про который я говорил ранее. Потом просто делаем дамп раскриптованной секции кода. Найти OEP проще всего если поставить BPX SetProcessWorkingsetSize там буквально через 20 строчек OEP. Дальше делаем дамп на OEP, вставляем в него полученную секцию кода. Восстанавливаем импорт(лучше под NT/2k, но и в 98 его тоже не проблема восстановить). И долбаемся с остатками лицензирования...

Что еще можно сказать... Если глянуть по адресам 44D60B и 44D57B то увидим такие же куски кода с двумя отличиями:


 _text1:0044D57B push 1 - Криптовать!
 ...............
 _text1:0044D5E8 mov eax, [ebp+PageNumber]
 _text1:0044D5EE sub eax, 1 - Предидущая страница
 _text1:0044D5F1 push eax ; PageNumber
 _text1:0044D5F2 call ArmaCryptDecrypt
 

и


 _text1:0044D60B push 1 - Криптовать!
 .........................
 _text1:0044D678 mov eax, [ebp+PageNumber]
 _text1:0044D67E add eax, 1 - Следующая страница
 _text1:0044D681 push eax ; PageNumber
 _text1:0044D682 call ArmaCryptDecrypt
 

Т.е. перед раскриптовкой новой станицы он криптует предидущую и следующую. В Armadillo 2.61 Public build 2000 это не используется но нужно иметь в виду :)




Описание протокола ARP (Address Resolution Protocol)

Обнаружен узел www.microsoft.com.
Ожидается ответ...
Обезврежен узел www.microsoft.com

Для определения локального адреса по IP-адресу используется протокол разрешения адреса Address Resolution Protocol, ARP. Протокол ARP работает различным образом в зависимости от того, какой протокол канального уровня работает в данной сети - протокол локальной сети (Ethernet, Token Ring, FDDI) с возможностью широковещательного доступа одновременно ко всем узлам сети, или же протокол глобальной сети (X.25, frame relay), как правило не поддерживающий широковещательный доступ. Существует также протокол, решающий обратную задачу - нахождение IP-адреса по известному локальному адресу. Он называется реверсивный ARP - RARP (Reverse Address Resolution Protocol) и используется при старте бездисковых станций, не знающих в начальный момент своего IP-адреса, но знающих адрес своего сетевого адаптера.

В локальных сетях протокол ARP использует широковещательные кадры протокола канального уровня для поиска в сети узла с заданным IP-адресом.

Узел, которому нужно выполнить отображение IP-адреса на локальный адрес, формирует ARP запрос, вкладывает его в кадр протокола канального уровня, указывая в нем известный IP-адрес, и рассылает запрос широковещательно. Все узлы локальной сети получают ARP запрос и сравнивают указанный там IP-адрес с собственным. В случае их совпадения узел формирует ARP-ответ, в котором указывает свой IP-адрес и свой локальный адрес и отправляет его уже направленно, так как в ARP запросе отправитель указывает свой локальный адрес. ARP-запросы и ответы используют один и тот же формат пакета. Так как локальные адреса могут в различных типах сетей иметь различную длину, то формат пакета протокола ARP зависит от типа сети.

В поле типа сети для сетей Ethernet указывается значение 1. Поле типа протокола позволяет использовать пакеты ARP не только для протокола IP, но и для других сетевых протоколов. Для IP значение этого поля равно 080016.

Длина локального адреса для протокола Ethernet равна 6 байтам, а длина IP-адреса - 4 байтам. В поле операции для ARP запросов указывается значение 1 для протокола ARP и 2 для протокола RARP.

Узел, отправляющий ARP-запрос, заполняет в пакете все поля, кроме поля искомого локального адреса (для RARP-запроса не указывается искомый IP-адрес). Значение этого поля заполняется узлом, опознавшим свой IP-адрес.

В глобальных сетях администратору сети чаще всего приходится вручную формировать ARP-таблицы, в которых он задает, например, соответствие IP-адреса адресу узла сети X.25, который имеет смысл локального адреса. В последнее время наметилась тенденция автоматизации работы протокола ARP и в глобальных сетях. Для этой цели среди всех маршрутизаторов, подключенных к какой-либо глобальной сети, выделяется специальный маршрутизатор, который ведет ARP-таблицу для всех остальных узлов и маршрутизаторов этой сети. При таком централизованном подходе для всех узлов и маршрутизаторов вручную нужно задать только IP-адрес и локальный адрес выделенного маршрутизатора. Затем каждый узел и маршрутизатор регистрирует свои адреса в выделенном маршрутизаторе, а при необходимости установления соответствия между IP-адресом и локальным адресом узел обращается к выделенному маршрутизатору с запросом и автоматически получает ответ без участия администратора.




Пример массива констант (Array of Const)

Автор: Steve

"Array of const" это массив переменных, декларированных как константы. Непосредственно они представлены структурой TVarRec. Скобки просто ограничивают массив. Массив констант дает вам возможность передавать процедуре переменное количество параметров type-safe (безопасным) способом. Вот пример:


 type
   TVarRec = record
     Data: record case Integer of
         0: (L: LongInt);
         1: (B: Boolean);
         2: (C: Char);
         3: (E: ^Extended);
         4: (S: ^string);
         5: (P: Pointer);
         6: (X: PChar);
         7: (O: TObject);
     end;
     Tag: Byte;
     Stuff: array[0..2] of Byte;
   end;
 
 function PtrToStr(P: Pointer): string;
 const
   HexChar: array[0..15] of Char = '0123456789ABCDEF';
 
   function HexByte(B: Byte): string;
   begin
     Result := HexChar[B shr 4] + HexChar[B and 15];
   end;
 
   function HexWord(W: Word): string;
   begin
     Result := HexByte(Hi(W)) + HexByte(Lo(W));
   end;
 
 begin
   Result := HexWord(HiWord(LongInt(P))) + ':' + HexWord(LoWord(LongInt(P)));
 end;
 
 procedure Display(X: array of const);
 var
   I: Integer;
 begin
   for I := 0 to High(X) do
     with TVarRec(X[I]), Data do
     begin
       case Tag of
         0: ShowMessage('Integer: ' + IntToStr(L));
         1: if B then
             ShowMessage('Boolean: True')
           else
             ShowMessage('Boolean: False');
         2: ShowMessage('Char: ' + C);
         3: ShowMessage('Float: ' + FloatToStr(E^));
         4: ShowMessage('String: ' + S^);
         5: ShowMessage('Pointer: ' + PtrToStr(P));
         6: ShowMessage('PChar: ' + StrPas(X));
         7: ShowMessage('Object: ' + O.ClassName);
       end;
     end;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   P: array[0..5] of Char;
 
 begin
   P := 'Привет'#0;
   Display([-12345678, True, 'A', 1.2345, 'ABC', Ptr($1234, $5678), P,
     Form1]);
 end;
 




Пример массива констант (Array of Const) 2

Массив констант (array of const) фактически является открытым массивом TVarRec (описание предекларированных типов Delphi вы можете найти в электронной справке). Приведенный ниже "псевдокод" на языке Object Pascal может послужить скелетом для дальнейшего развития:


 procedure AddStuff(const A: array of const);
 var
   i: Integer;
 begin
   for i := Low(A) to High(A) do
     with A[i] do
       case VType of
         vtExtended:
           begin
             { добавляем натуральное число, все real-форматы
             автоматически приводятся к extended }
           end;
         vtInteger:
           begin
             { добавляем целое число, все integer-форматы
             автоматически приводятся к LongInt }
           end;
         vtObject:
           begin
             if VObject is DArray then
               with DArray(VObject) do
               begin
                 { добавляем массив double-типа }
               end
             else if VObject is IArray then
               with IArray(VObject) do
               begin
                 { добавляем массив integer-типа }
               end;
           end;
       end; { Case }
 end; { AddStuff }
 

Для получения дополнительной информации загляните в главу "open arrays" электронной справки.




Копирование массива целочисленных чисел в Blob-поле

Как мне в таблице Paradox скопировать массив целочисленных чисел в TBlobField и наоборот? Элементы массива являются точками графика данных, который я хочу выводить, если запись доступна.

Запишите массив в поток памяти и затем используйте метод TBlob LoadFromStream. Для извлечения данных используйте метод TBlob SaveToStream (сохранение и извлечение массива из потока памяти).




Сохранение в файле массива

Следующий код может помочь вам начать.


 type
   TCharArray = array[500] of Char;
 
 procedure WriteToFile(var aArray: TCharArray; sFileName: string); {Примечание:
 Объявление массива как параметр Var позволяет передавать только ссылку на массив,
 а не копировать его целиком в стек, если же вам нужна безопасная работа с массивом,
 то вам не следует передавать его как var-параметр. }
 var
   nArrayIndex: Word;
   fFileHandle: TextFile;
 begin
   AssignFile(fFileHandle, sFileName);
   Rewrite(fFileHandle);
 
   for nArrayIndex := 1 to 500 do
   begin
     Write(fFileHandle, aArray[nArrayIndex]);
   end;
 
   CloseFile(fFileHandle);
 end; {end Procedure, WriteToFile()}
 




Как поместить двумерный массив в Image

Разговор двух комьютеров:
- Я своему ламеру говорю "Fatal error", его сыну - "Game over", а сам - On line, On line, On line...

Представим, что данные находятся в массиве:


 TestArray : array[0..127, 0..127] of Byte;
 

Картинка будет иметь размер 128 x 128 точек:


Image1.Picture.Bitmap.Width := 128;
 Image1.Picture.Bitmap.Height := 128;
 

Вызываем функцию Windows API для формирования BitMap:


 SetBitmapBits(Image1.Picture.Bitmap.Handle, sizeof(TestArray), @TestArray);
 Image1.Refresh; {для того, чтобы изменения отобразились}
 

Однако, если вы используете свою палитру, то ее нужно создать




Массив без ограничения типа и размера

Автор: Сергей Дьяченко

Пришло от читателя письмо:

Я тут посмотрел Ваши советы, и понял: это здорово! мне понравилось. Но в них я не нашел (может невнимательно смотрел?) возможности работать с массивами неограниченными по размеру и типу и вообще.


 //к примеру опишем свой тип
 type
   MyType = record
     zap1: longword;
     zap2: char;
     zap3: string[10];
   end;
 
   //опишем НЕОГРАНИЧЕННЫЙ массив переменный типа MyType
   //хотя, может использоваться абсолютно любой
 var
   m: array of MyType;
 
   ....
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   i: byte;
 begin
   for i := 0 to 9 do // нумерация элементов начинается с нуля!
 
   begin
     SetLength(m, Length(m) + 1); // увеличение длины массива на 1
     m[i].zap1 := i; // присвоение
     m[i].zap2 := chr(i); // полям
     m[i].zap3 := inttostr(i); // значений
   end;
 end;
 
 ....
 
 SetLength(m, 0); // освобождение памяти
 end.
 




ASCII-файл с использованием полей

Автор: OAmiry (Borland)

В том случае, когда вы собираетесь использовать содержимое текстового файла таким образом, как будто он имеет поля, вам необходим файл схемы, содержащий описание формата текстового файла и который необходим для осуществления вызовов при работе с полями (Fields / FieldByName / Post / и др.). Ниже приводится код, который вы можете использовать при создании своей программы:


 { Подразумеваем, что Table1 - файл, который мы хотим скопировать
 в ASCII-файл. Используем TBatchMove, поскольку быстро работает.
 Также это автоматически создаст файл схемы }
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
 
   oDest: TTable;
   oBMove: TBatchMove;
 begin
 
   try
     oDest := nil;
     oBMove := nil;
     Table1.Close;
 
     oDest := TTable.Create(nil);
     with oDest do
     begin
       DatabaseName := 'c:\delphi\files';
       TableName := 'Test.Txt';
       TableType := ttASCII;
     end; {Обратите внимание на то, что нет необходимости вызывать CreateTable}
 
     oBMove := TBatchMove.Create(nil);
     with oBMove do
     begin
       Source := Table1;
       Destination := oDest;
       Mode := batCopy;
       Execute;
     end;
   finally
     if Assigned(oDest) then
       oDest.Free;
     if Assigned(oBMove) then
       oBMove.Free;
   end;
 end;
 
 { Теперь, допустим, файл схемы существует;
 сам текстовый файл может как быть, так его может и не быть.
 С помощью файла схемы мы уже можем работать с полями }
 
 procedure TForm1.Button2Click(Sender: TObject);
 var
 
   oTxt: TTable;
   i: Integer;
   f: System.Text;
 begin
 
   try
     oTxt := nil;
 
     if not FileExists('c:\delphi\files\Test.Txt') then
     begin
       AssignFile(f, 'c:\delphi\files\Test.Txt');
       Rewrite(f);
       CloseFile(f);
     end;
 
     oTxt := TTable.Create(nil);
     with oTxt do
     begin
       DatabaseName := 'c:\delphi\files';
       TableName := 'Test.Txt';
       TableType := ttASCII;
       Open;
     end;
 
     with Table1 do
     begin
       DisableControls;
       if not Active then
         Open;
       First;
       while not EOF do
       begin
         oTxt.Insert;
         { В данном случае файл схемы описывает формат текстового файла; в этом
         примере фактически один к одному воспроизводятся поля таблицы
         в логическое определение полей в .sch-файле }
         for i := 0 to FieldCount - 1 do
           oTxt.Fields[i].AsString := Fields[i].AsString;
         oTxt.Post;
         Next;
       end;
     end;
   finally
     Table1.EnableControls;
     if Assigned(oTxt) then
       oTxt.Free;
   end;
 
 end;
 




ASCII драйвер для CSV-файлов

Вопрос:
- Помогите найти "дрoва" на крышку от батареек у радиомыши.

Использование драйвера ASCII для файлов с разделительной запятой

Delphi (и BDE) имеют способность использовать ASCII файлы для хранения таблиц. Драйвер ASCII имеет возможность транслировать значения данных ASCII-поля фиксированной длины или файла с разделительной запятой в поля и величины, которые могут отображаться компонентом TTable. Трансляция ASCII файла целиком зависит от сопровождающего файла схемы (Schema File). Файл схемы для файла ASCII данных определяет различные атрибуты, необходимые для преобразования данных ASCII файла в значения отдельных полей. Определения полей для файла с ASCII полями фиксированной длины достаточно простая задача, необходимо знать позиции всех полей, для всех строк они одинаковы. Для файлов с разделительной запятой данный процесс чуть более усложнен из-за того, что не все данные в таком файле во всех строках имеют одинаковую длину. Данный совет как раз и концентрируется на описании этой трудной темы, связанной с чтением данных из файлов с разделительной запятой, имеющих варьируемую длину поля.

Файл схемы

Файл схемы для файла данных ASCII содержит информацию, которая определяет оба типа файла (версии с разделительной запятой и полем с фиксированной длиной), а также определяет поля, которые представлены значениями данных в каждой строке файла данных ASCII. (Все поля файла схемы нечуствительны к регистру, поэтому написание "ascii" равнозначно написанию "ASCII".) Для того, чтобы файл схемы был признан в качестве такового, он должен иметь то же имя, что и файл данных ASCII, для которого он содержит схему, но иметь расширение .SCH (SCHema - схема). Атрибуты описания файла:

   File name: Располагаемый в квадратных скобках, данный атрибут определяет
              имя файла ASCII данных (с расширением имени файла,
              которое должно быть .TXT).
 
   Filetype:  Определяет, имеет ли файл ASCII данных структуру файла с
              полями фиксированной длины (используется атрибут FIXED) или
              файлом с разделительной запятой (со значениями данных, которые
              потенциально могут изменять длину (используется атрибут VARYING).
 
   Delimiter: Определяет символ, которым "окантуривают" значения данных типа
              String (обычно двойные кавычки, десятичный ASCII код 34).
 
   Separator: Определяет символ, который используется для разделения отдельных
              значений данных (обычно запятая). Данный символ должен быть
              видимым символом, т.е. не может быть пробелом (десятичный ASCII
              код 32).
 
   CharSet:   Определяет драйвер языка (используется атрибут ASCII).
Расположенные ниже атрибуты файла являются определениями поля, задающими правила для каждой строки файла данных ASCII. Данные определения служат источником информации для Delphi и BDE, первоначально необходимой для создания виртуального поля в памяти, в свою очередь служащее для хранения значений данных; тип данных виртуального поля определяется после чтения и трансляции данных из ASCII файла, определения размера и применения атрибутов. Различные атрибуты, определяющие поле файла данных ASCII:

  Field:    Имя виртуального поля (всегда будет "Field"), сопровождаемое
                целым числом, определяющим порядковый номер поля относительно
                других полей в файле данных ASCII. Например, первое поле -
                Field1, второе Field2, и т.д..
 
   Field name: Определяет выводимое имя поля, отображаемое в виде
                       заголовка колонки в TDBGrid. Соглашения имен для
                       таблиц ASCII такие же, как и для таблиц Paradox.
 
   Field type:   Определяет, какой тип данных BDE должен использоваться при
                       трансляции значений данных каждого поля и сообщает
                       Delphi тип виртуального поля, которое необходимо создать.
 
                       Используйте определение Для значений типа
                       ----------------------- ----------------------------
                       CHAR                    Символ
                       FLOAT                   64-битное число с плавающей точкой
                       NUMBER               16-битное целое
                       BOOL                    Boolean (T или F)
                       LONGINT              32-битное длинное целое
                       DATE                    Поле Date.
                       TIME                    Поле Time.
                       TIMESTAMP        Поле Date + Time.
 
                       (Фактически формат для значений данных даты и времени
                       будет определяться текущими настройками конфигурации BDE,
                       страница с закладкой Date.)
 
   Data value length:  Максимальная длина значения данных соответствующего поля.
                       Данный атрибут определяет длину виртуального поля,
                       создаваемое Delphi для получения считываемых значений из
                       ASCII-файла.
 
   Number of decimals: Приложение к полю типа FLOAT; определяет количество цифр
                       справа от десятичной точки; необходимо для включения в
                       определение виртуального поля.
 
   Offset:          Отступ от начала строки, позиция начала данных описываемого
                       поля; задается для всех строк файла.
Например, приведенное ниже определение поля относится к первому полю таблицы ASCII. Данная строка определяет значения данных типа String с именем "Text", максимальная длина значения данных составляет три символа (и в Delphi компонентах для работы с базами данных, типа TDBGrid, поле будет отображаться только тремя символами), десятичный порядок (значение данных типа String никогда не сможет иметь десятичные значения, тем более после запятой), и смещение относительно нулевой позиции (поскольку описываемая область первая, то она сама начинается с нулевой позиции, перед ней не находится ни одно поле).

  Field1=Text,Char,3,00,00
Вот пример файла схемы с тремя полями, первое поле имеет тип String, второе и третье тип Date. Данный файл схемы должен содержаться в файле с именем DATES.SCH и обеспечивать определения полей для файла данных ASCII с именем DATES.TXT.
   [DATES]
   Filetype=VARYING
   Delimiter="
   Separator=,
   CharSet=ascii
   Field1=Text,Char,3,00,00
   Field2=First Contact,Date,10,00,03
   Field3=Second,Date,10,00,13
Данная схема определяет поле с разделительной запятой, где все данные могут быть отнесены к типу String, значения полей "окантурены" двойными кавычками и отдельные значения полей разделены запятой (за исключением любых запятых, которые могут находится между разделительными запятыми, внутри отдельных значений полей типа String). Первое поле типа character имеет длину три символа, без определения десятичного порядка и с нулевым отступом от начала строки. Второе поле данных имеет длину 10, без определения десятичного порядка и отступ, равный трем. Третье поле данных имеет длину 10, без определения десятичного порядка и отступ, равный 13.

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

Вот файл данных с именем DATES.TXT, который соответствует описанному выше файлу схемы:

   "A",08/01/1995,08/11/19955
   "BB",08/02/1995,08/12/1995
   "CCC",08/03/1995,08/13/1995
Максимальная длина фактических значений данных в первом поле составляет три символа ("CCC"). Поскольку это первое поле и предшествующих полей не существует, отступ для данного поля равен нулю. Длина первого поля (3) используется в качестве отступа для второго поля. Длина второго поля, значение date, равно 10 и отражает максимальную длину значения данных этого поля. Совокупная длина первого и второго полей используется в качестве значения отступа для третьего поля (3 + 10 = 13).

Только когда соответствующая длина значения данных ASCII файла или длина каждого поля добавляется к длине предыдущих полей, вычисляется значение отступа и получается позиция очередного поля, только тогда данный процесс правильно считает данные. Если из-за неправильных установочных параметров в файле схемы данные транслируются неверно, то в большинстве типов полей могут возникнуть неблагоприятные эффекты типа обрезания строк, или интерпретирование цифр как нулей. Обычно в таком случае данные выводятся, но ошибки не возникает. Тем не менее, значения определенного формата в процессе трансляции в подходящий тип данных могут вызвать ошибку, если считываемые символы не соответствуют символам, например, в типе date. В контексте вышесказанного, ошибка с типом datе может возникнуть и-за того, что при неправильном определении в значения данных могут попасть данные другого, соседнего поля. При таком стечение обстоятельств трансляция данных прерывается, и в файле схемы требуется установка правильной длины поля и его отступа.




Формат файла ASCII-схемы

В файле asciidrv.txt насчет последнего числа в строке схемы поля говорится:

"* Offset - Number of characters from the beginning of the line that the field begins. Used for FIXED format only." (Offset - количество символов он начала линии до начала поля. Используется только для фиксированного формата.).

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


 [discs]
 filetype = varying
 charset = ascii
 delimiter = "
 separator = ,
 field1 = id,char,10,0,1
 field2 = title,char,30,0,2
 field3 = artist,char,30,0,3
 ...
 field36 = song30,char,50,0,36
 

После более произвольных изменений это стало таким:


 [discs]
 filetype = varying
 charset = ascii
 delimiter = "
 separator = ,
 field1 = id,char,10,0,10
 field2 = title,char,30,0,20
 field3 = artist,char,30,0,30
 ...
 field36 = song30,char,50,0,360
 

и внезапно все заработало! Для поля, которое игнорируется форматом файла, "Offset" несомненно дало огромный эффект.




Преобразование ASCII в шестнадцатиричное представление

Строка представляет собой массив байтов в виде ASCII-символов. Необходимо организовать преобразование типов по аналогии с Delphi-функциями Ord и Chr.

Функция BytesToHexStr преобразует, к примеру, набор байтов [0,1,1,0] в строку '30313130', HexStrToBytes выполнит обратное преобразование.


 unit Hexstr;
 
 interface
 uses String16, SysUtils;
 
 type
 
   PByte = ^BYTE;
 
 procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength:
   WORD);
 
 procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
 procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength:
   WORD);
 
 implementation
 
 procedure BytesToHexStr(var hHexStr: string; pbyteArray: PByte; InputLength:
   WORD);
 const
 
   HexChars: array[0..15] of Char = '0123456789ABCDEF';
 var
 
   i, j: WORD;
 begin
 
   SetLength(hHexStr, (InputLength * 2));
   FillChar(hHexStr, sizeof(hHexStr), #0);
   j := 1;
   for i := 1 to InputLength do
   begin
     hHexStr[j] := Char(HexChars[pbyteArray^ shr 4]);
     inc(j);
     hHexStr[j] := Char(HexChars[pbyteArray^ and 15]);
     inc(j);
     inc(pbyteArray);
   end;
 end;
 
 procedure HexBytesToChar(var Response: string; hexbytes: PChar; InputLength:
   WORD);
 var
 
   i: WORD;
   c: byte;
 begin
 
   SetLength(Response, InputLength);
   FillChar(Response, SizeOf(Response), #0);
   for i := 0 to (InputLength - 1) do
   begin
     c := BYTE(hexbytes[i]) and BYTE($F);
     if c > 9 then
       Inc(c, $37)
     else
       Inc(c, $30);
     Response[i + 1] := char(c);
   end; {for}
 end;
 
 procedure HexStrToBytes(hHexStr: string; pbyteArray: Pointer);
 {pbyteArray указывает на область памяти, хранящей результаты}
 var
 
   i, j: WORD;
   tempPtr: PChar;
   twoDigits: string[2];
 begin
 
   tempPtr := pbyteArray;
   j := 1;
   for i := 1 to (Length(hHexStr) div 2) do
   begin
     twoDigits := Copy(hHexStr, j, 2);
     Inc(j, 2);
     PByte(tempPtr)^ := StrToInt('$' + twoDigits);
     Inc(tempPtr);
   end; {for}
 end;
 
 end.
 
 


 unit String16.
 interface
 {$IFNDEF Win32}
 
 procedure SetLength(var S: string; Len: Integer);
 procedure SetString(var Dst: string; Src: PChar; Len: Integer);
 {$ENDIF}
 implementation
 {$IFNDEF Win32}
 
 procedure SetLength(var S: string; Len: Integer);
 begin
   if Len > 255 then
     S[0] := Chr(255)
   else
     S[0] := Chr(Len)
 end;
 
 procedure SetString(var Dst: string; Src: PChar; Len: Integer);
 begin
   if Len > 255 then
     Move(Src^, Dst[1], 255)
   else
     Move(Src^, Dst[1], Len);
   SetLength(Dst, Len);
 end;
 {$ENDIF}
 end.
 




Ассемблер в Delphi

Автор: Ian Hodger

Чайник со свистком - это милиционер за компьютером.

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

Основное направление статьи, это познакомиться с использованием ассемблера в Object Pascal. Однако, не будем пропускать и те аспекты программирования, которые будут требовать пояснения для конкретных примеров, приведённых в этой статье.

Использование Ассемблера в Борландовком Delphi

Перед тем, как начать, хотелось бы определиться с уровнем знаний, необходимых для нормального усвоения данного материала. Необходимо быть знакомым со встроенными средствами отладки в Delphi. Так же необходимо иметь представление о таких терминах как тип реализации (instantiation), null pointer и распределение памяти. Если в чём-то из вышеупомянутого Вы сомневаетесь, то постарайтесь быть очень внимательны и осторожны при воплощении данного материала на практике. Кроме того, будет обсуждаться только 32-битный код, так что понадобится компилятор не ниже Delphi 2.0.

Зачем использовать Ассемблер? На мой взгляд, Object Pascal, это инструмент, позволяющий генерировать быстрый и эффективный код, однако использование ассемблера в некоторых случаях позволяет решать некоторые задачи более эффективно. За всю работу с Delphi, я пришёл к выводу, что использование низкоуровневого кода необходимо в двух случая.

(1) Обработка большого количества данных. Nb. В данный случай не входит ситуация, когда используется язык запроса данных.

(2) В высокоскоростных подпрограммах работы с дисплеем. Nb. Имеется ввиду использование простых процедур на чистом паскале, но никак не внешних библиотек и DirectX.

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

Что такое Ассемблер? Надеюсь, что Все читатели этой статьи имеют как минимум поверхностное представление о работе процессора. Грубо говоря, это калькулятор с большим объёмом памяти. Память, это не более чем упорядоченная последовательнось двоичных цифр. Каждая такая цифра является байтом. Каждый байт может содержать в себе значение от 0 до 255, а так же имеет свой уникальный адрес, при помощи которого процессор находит нужные значения в памяти. Процессор так же имеет набор регистров (это можно расценить как глобальные переменные). Например eax,ebx,ecx и edx, это универсальные 32-битные регистры. Это значит, что самое большое число, которое мы можем записать в регистр eax, это 2 в степени 32 минус 1, или 4294967295.

Как мы уже выяснили, процессор манипулирует значениями регистров. Машинный код операции прибавления 10 к значению регистра eax будет выглядеть следующим образом

 05/0a/00/00/00
 

Однако, такая запись абсолютно не читабельна и, как следствие, не пригодна при отладке программы. Так вот Ассемблер, это простое представление машинных команд в более удобном виде. Теперь давайте посмотрим, как будет выглядеть прибавление 10 к eax в ассемблерном представлении:

 add eax,10 {a := a + 10}
 

А вот так выглядит вычитаение значения ebx из eax

 sub eax,ebx {a := a - b }
 

Чтобы сохранить значние, можно просто поместить его в другой регистр

 mov eax,ecx {a := c }
 

или даже лучше, сохранить значение по определённому адресу в памяти

 mov [1536],eax {сохраняет значение eax по адресу 1536}
 

и конечно же взять его от туда

 mov eax,[1536]
 

Однако, тут есть важный момент, про который забывать не желательно. Так как регистр 32-битный(4 байта), то его значение будет записано сразу в четыре ячейки памяти 1536, 1537, 1538 и 1539.

А теперь давайте посмотрим, как компилятор преобразует действия с переменными в машинный код. Допустим у нас есть строка

 Count := 0;
 

Для компилятора это означает, что надо просто запомнить значение. Следовательно, компилятор генерирует код, который сохраняет значение в памяти по определённому адресу и следит, чтобы не произошло никаких накладок, и обзывает этот адрес как 'Count'. Вот как выглядит такой код

 mov eax,0
 mov Count,eax
 

Компилятор не может использовать строку типа

 mov Count,0
 

из-за того, что как минимум один параметр инструкции должен являться регистром. Если посмотреть на строку

 Count := Count + 1;
 

то

 mov eax,Count
 add eax,1
 mov Count,eax
 

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

Итак, рассмотрим первый пример. Сразу извинюсь за тривиальность, но с чего-то надо начинать.


 function Sum(X, Y: integer): integer;
 begin
  Result := X + Y;
 end;
 

А вот так будет выглядеть оперция сложения двух целых чисел на ассемблере:


 function Sum(X,Y:integer):integer;
 begin
  asm
   mov eax,X
   add eax,Y
   mov Result,eax
  end;
 end;
 

Этот код прекрасно работает, однако он не даёт нам преимущества в скорости, а так же потерялось восприятие кода. Но не стоит огорчаться, так как те немногие знания, которые Вы почерпнули из этого материала, можно использовать с большей пользой. Допустим, нам необходимо преобразовать явные значения Red,Green, и Blue в цвета типа TColor, подходящие для использования в Delphi. Тип TColor описан как 24-битный True Colour хранящийся в формате целого числа, то есть четыре байта, старший из которых равен нулю, а далее по порядку красный, зелёный, синий.


 function GetColour(Red,Green,Blue:integer):TColor;
 begin
  asm
 {ecx будет содержать значение TColor}
   mov ecx,0
 {начинаем с красной компоненты}
   mov eax,Red
 {необходимо убедиться, что красный находится в диапазоне 0<=Red<=255}
   and eax,255
 {сдвигаем значение красного в правильное положение}
   shl eax,16
 {выравниваем значение TColor}
   xor ecx,eax
 {проделываем тоже самое с зелёным}
   mov eax,Green
   and eax,255
   shl eax,8
   xor ecx,eax
 {и тоже самое с синим}
   mov eax,Blue
   and eax,255
   xor ecx,eax
   mov Result, ecx
  end;
 end;
 

Заметьте, что я использовал несколько бинарных операций. Эти операции также определены непосредственно в Object Pascal.




Использование ассоциативных массивов

С чего начинается Windows?
С формата на вашем винте!


 procedure TForm1.Button1Click(Sender: TObject);
 var
   DataField: TStrings;
 begin
   DataField := TStringList.Create;
   DataField.Add(Format('%s=%s', ['Jonas', '15.03.1980']));
   ShowMessage(DataField.Values['Jonas'])
   // will print the Birthday of Jonas 
   DataField.Free;
 end;
 




Ассоциативное выполнение

У Нострадамуса нашли стих, который описывает апгрейд копмьютера: "...старая мать новым камнем украсится станет умней и быстрее работать..."


 unit UcShell;
 
 interface
 
 uses
   Classes, SysUtils, Windows, ShellApi, Forms;
 
 {---------------------------------------------------------------}
 
 function WinExecutableName(const AssociatedFile: string): string;
 
 procedure WinShellOpen(const AssociatedFile: string);
 procedure WinShellPrint(const AssociatedFile: string);
 procedure WinShellExecute(const Operation, AssociatedFile: string);
 
 {---------------------------------------------------------------}
 
 implementation
 
 const
   cStrBufSize = 80;
 
 {---------------------------------------------------------------}
 
 function WinExecutableName(const AssociatedFile: string): string;
 //HINSTANCE FindExecutable(
 //    LPCTSTR lpFile,      // указатель на строку с именем файла
 //    LPCTSTR lpDirectory, // указатель на строку с директорией по умолчанию
 //    LPTSTR lpResult      // указатель на буфер для строки, возвращаемой выполняемым файлом
 //   );
 begin
   SetLength(result, cStrBufSize); //ucshell
   FindExecutable(pchar(AssociatedFile), '', pchar(result));
   SetLength(result, strlen(pchar(result)));
 end;
 
 //
 
 procedure WinShellExecute(const Operation, AssociatedFile: string);
 var
   a1: string;
 begin
   a1 := Operation;
   if a1 = '' then
     a1 := 'open';
   ShellExecute(
     application.handle //hWnd: HWND
     , pchar(a1) //Operation: PChar
     , pchar(AssociatedFile) //FileName: PChar
     , '' //Parameters: PChar
     , '' //Directory: PChar
     , SW_SHOWNORMAL //ShowCmd: Integer
     );
   //  GetLastErrorString(0); //ucdialog
 end;
 
 procedure WinShellPrint(const AssociatedFile: string);
 begin
   WinShellExecute('print', AssociatedFile);
 end;
 
 procedure WinShellOpen(const AssociatedFile: string);
 begin
   WinShellExecute('open', AssociatedFile);
 end;
 
 {-----------------------------------------------------------------}
 end.
 




Ассинхронная связь

Oдна барышня звонила на какую-то фирму и ругалась, что они ей какой-то не такой софт подсунули, что он не инсталлируется, хотя она все, мол, делает в соответствии с инструкцией (а софт ентот с дискет ставился). Ну, послали спеца из фирмы, продавшей этот софт, на месте разобраться what's, собственно, up... Приехал он, а барышня ему и говорит:
- Вот у вас в инструкции написано - "вставьте дискету #1", ну я вставила, потом написано вставить дискету #2, ну,- говорит, - я ее вставила, потом - дискету #3, ну вставила я ее (с трудом, правда), но вот дискета #4 уже просто в дисковод не лезет!!!


 unit Comm;
 
 interface
 uses
   Messages, WinTypes, WinProcs, Classes, Forms;
 
 type
 
   TPort = (tptNone, tptOne, tptTwo, tptThree, tptFour, tptFive, tptSix,
     tptSeven,
     tptEight);
   TBaudRate = (tbr110, tbr300, tbr600, tbr1200, tbr2400, tbr4800, tbr9600,
     tbr14400,
     tbr19200, tbr38400, tbr56000, tbr128000, tbr256000);
   TParity = (tpNone, tpOdd, tpEven, tpMark, tpSpace);
   TDataBits = (tdbFour, tdbFive, tdbSix, tdbSeven, tdbEight);
   TStopBits = (tsbOne, tsbOnePointFive, tsbTwo);
   TCommEvent = (tceBreak, tceCts, tceCtss, tceDsr, tceErr, tcePErr, tceRing,
     tceRlsd,
     tceRlsds, tceRxChar, tceRxFlag, tceTxEmpty);
   TCommEvents = set of TCommEvent;
 
 const
 
   PortDefault = tptNone;
   BaudRateDefault = tbr9600;
   ParityDefault = tpNone;
   DataBitsDefault = tdbEight;
   StopBitsDefault = tsbOne;
   ReadBufferSizeDefault = 2048;
   WriteBufferSizeDefault = 2048;
   RxFullDefault = 1024;
   TxLowDefault = 1024;
   EventsDefault = [];
 
 type
 
   TNotifyEventEvent = procedure(Sender: TObject; CommEvent: TCommEvents) of
     object;
   TNotifyReceiveEvent = procedure(Sender: TObject; Count: Word) of object;
   TNotifyTransmitEvent = procedure(Sender: TObject; Count: Word) of object;
 
   TComm = class(TComponent)
   private
     FPort: TPort;
     FBaudRate: TBaudRate;
     FParity: TParity;
     FDataBits: TDataBits;
     FStopBits: TStopBits;
     FReadBufferSize: Word;
     FWriteBufferSize: Word;
     FRxFull: Word;
     FTxLow: Word;
     FEvents: TCommEvents;
     FOnEvent: TNotifyEventEvent;
     FOnReceive: TNotifyReceiveEvent;
     FOnTransmit: TNotifyTransmitEvent;
     FWindowHandle: hWnd;
     hComm: Integer;
     HasBeenLoaded: Boolean;
     Error: Boolean;
     procedure SetPort(Value: TPort);
     procedure SetBaudRate(Value: TBaudRate);
     procedure SetParity(Value: TParity);
     procedure SetDataBits(Value: TDataBits);
     procedure SetStopBits(Value: TStopBits);
     procedure SetReadBufferSize(Value: Word);
     procedure SetWriteBufferSize(Value: Word);
     procedure SetRxFull(Value: Word);
     procedure SetTxLow(Value: Word);
     procedure SetEvents(Value: TCommEvents);
     procedure WndProc(var Msg: TMessage);
     procedure DoEvent;
     procedure DoReceive;
     procedure DoTransmit;
   protected
     procedure Loaded; override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     procedure Write(Data: PChar; Len: Word);
     procedure Read(Data: PChar; Len: Word);
     function IsError: Boolean;
   published
     property Port: TPort read FPort write SetPort default PortDefault;
     property BaudRate: TBaudRate read FBaudRate write SetBaudRate
       default BaudRateDefault;
     property Parity: TParity read FParity write SetParity default ParityDefault;
     property DataBits: TDataBits read FDataBits write SetDataBits
       default DataBitsDefault;
     property StopBits: TStopBits read FStopBits write SetStopBits
       default StopBitsDefault;
     property WriteBufferSize: Word read FWriteBufferSize
       write SetWriteBufferSize default WriteBufferSizeDefault;
     property ReadBufferSize: Word read FReadBufferSize
       write SetReadBufferSize default ReadBufferSizeDefault;
     property RxFullCount: Word read FRxFull write SetRxFull
       default RxFullDefault;
     property TxLowCount: Word read FTxLow write SetTxLow default TxLowDefault;
     property Events: TCommEvents read FEvents write SetEvents
       default EventsDefault;
     property OnEvent: TNotifyEventEvent read FOnEvent write FOnEvent;
     property OnReceive: TNotifyReceiveEvent read FOnReceive write FOnReceive;
     property OnTransmit: TNotifyTransmitEvent read FOnTransmit write
       FOnTransmit;
   end;
 
 procedure Register;
 
 implementation
 
 procedure TComm.SetPort(Value: TPort);
 const
 
   CommStr: PChar = 'COM1:';
 begin
 
   FPort := Value;
   if (csDesigning in ComponentState) or
     (Value = tptNone) or (not HasBeenLoaded) then
     exit;
   if hComm >= 0 then
     CloseComm(hComm);
   CommStr[3] := chr(48 + ord(Value));
   hComm := OpenComm(CommStr, ReadBufferSize, WriteBufferSize);
   if hComm < 0 then
   begin
     Error := True;
     exit;
   end;
   SetBaudRate(FBaudRate);
   SetParity(FParity);
   SetDataBits(FDataBits);
   SetStopBits(FStopBits);
   SetEvents(FEvents);
   EnableCommNotification(hComm, FWindowHandle, FRxFull, FTxLow);
 end;
 
 procedure TComm.SetBaudRate(Value: TBaudRate);
 var
 
   DCB: TDCB;
 begin
 
   FBaudRate := Value;
   if hComm >= 0 then
   begin
     GetCommState(hComm, DCB);
     case Value of
       tbr110: DCB.BaudRate := CBR_110;
       tbr300: DCB.BaudRate := CBR_300;
       tbr600: DCB.BaudRate := CBR_600;
       tbr1200: DCB.BaudRate := CBR_1200;
       tbr2400: DCB.BaudRate := CBR_2400;
       tbr4800: DCB.BaudRate := CBR_4800;
       tbr9600: DCB.BaudRate := CBR_9600;
       tbr14400: DCB.BaudRate := CBR_14400;
       tbr19200: DCB.BaudRate := CBR_19200;
       tbr38400: DCB.BaudRate := CBR_38400;
       tbr56000: DCB.BaudRate := CBR_56000;
       tbr128000: DCB.BaudRate := CBR_128000;
       tbr256000: DCB.BaudRate := CBR_256000;
     end;
     SetCommState(DCB);
   end;
 end;
 
 procedure TComm.SetParity(Value: TParity);
 var
 
   DCB: TDCB;
 begin
 
   FParity := Value;
   if hComm < 0 then
     exit;
   GetCommState(hComm, DCB);
   case Value of
     tpNone: DCB.Parity := 0;
     tpOdd: DCB.Parity := 1;
     tpEven: DCB.Parity := 2;
     tpMark: DCB.Parity := 3;
     tpSpace: DCB.Parity := 4;
   end;
   SetCommState(DCB);
 end;
 
 procedure TComm.SetDataBits(Value: TDataBits);
 var
 
   DCB: TDCB;
 begin
 
   FDataBits := Value;
   if hComm < 0 then
     exit;
   GetCommState(hComm, DCB);
   case Value of
     tdbFour: DCB.ByteSize := 4;
     tdbFive: DCB.ByteSize := 5;
     tdbSix: DCB.ByteSize := 6;
     tdbSeven: DCB.ByteSize := 7;
     tdbEight: DCB.ByteSize := 8;
   end;
   SetCommState(DCB);
 end;
 
 procedure TComm.SetStopBits(Value: TStopBits);
 var
 
   DCB: TDCB;
 begin
 
   FStopBits := Value;
   if hComm < 0 then
     exit;
   GetCommState(hComm, DCB);
   case Value of
     tsbOne: DCB.StopBits := 0;
     tsbOnePointFive: DCB.StopBits := 1;
     tsbTwo: DCB.StopBits := 2;
   end;
   SetCommState(DCB);
 end;
 
 procedure TComm.SetReadBufferSize(Value: Word);
 begin
 
   FReadBufferSize := Value;
   SetPort(FPort);
 end;
 
 procedure TComm.SetWriteBufferSize(Value: Word);
 begin
 
   FWriteBufferSize := Value;
   SetPort(FPort);
 end;
 
 procedure TComm.SetRxFull(Value: Word);
 begin
 
   FRxFull := Value;
   if hComm < 0 then
     exit;
   EnableCommNotification(hComm, FWindowHandle, FRxFull, FTxLow);
 end;
 
 procedure TComm.SetTxLow(Value: Word);
 begin
 
   FTxLow := Value;
   if hComm < 0 then
     exit;
   EnableCommNotification(hComm, FWindowHandle, FRxFull, FTxLow);
 end;
 
 procedure TComm.SetEvents(Value: TCommEvents);
 var
 
   EventMask: Word;
 begin
 
   FEvents := Value;
   if hComm < 0 then
     exit;
   EventMask := 0;
   if tceBreak in FEvents then
     inc(EventMask, EV_BREAK);
   if tceCts in FEvents then
     inc(EventMask, EV_CTS);
   if tceCtss in FEvents then
     inc(EventMask, EV_CTSS);
   if tceDsr in FEvents then
     inc(EventMask, EV_DSR);
   if tceErr in FEvents then
     inc(EventMask, EV_ERR);
   if tcePErr in FEvents then
     inc(EventMask, EV_PERR);
   if tceRing in FEvents then
     inc(EventMask, EV_RING);
   if tceRlsd in FEvents then
     inc(EventMask, EV_RLSD);
   if tceRlsds in FEvents then
     inc(EventMask, EV_RLSDS);
   if tceRxChar in FEvents then
     inc(EventMask, EV_RXCHAR);
   if tceRxFlag in FEvents then
     inc(EventMask, EV_RXFLAG);
   if tceTxEmpty in FEvents then
     inc(EventMask, EV_TXEMPTY);
   SetCommEventMask(hComm, EventMask);
 end;
 
 procedure TComm.WndProc(var Msg: TMessage);
 begin
 
   with Msg do
   begin
     if Msg = WM_COMMNOTIFY then
     begin
       case lParamLo of
         CN_EVENT: DoEvent;
         CN_RECEIVE: DoReceive;
         CN_TRANSMIT: DoTransmit;
       end;
     end
     else
       Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
   end;
 end;
 
 procedure TComm.DoEvent;
 var
 
   CommEvent: TCommEvents;
   EventMask: Word;
 begin
 
   if (hComm < 0) or not Assigned(FOnEvent) then
     exit;
   EventMask := GetCommEventMask(hComm, Integer($FFFF));
   CommEvent := [];
   if (tceBreak in Events) and (EventMask and EV_BREAK <> 0) then
     CommEvent := CommEvent + [tceBreak];
   if (tceCts in Events) and (EventMask and EV_CTS <> 0) then
     CommEvent := CommEvent + [tceCts];
   if (tceCtss in Events) and (EventMask and EV_CTSS <> 0) then
     CommEvent := CommEvent + [tceCtss];
   if (tceDsr in Events) and (EventMask and EV_DSR <> 0) then
     CommEvent := CommEvent + [tceDsr];
   if (tceErr in Events) and (EventMask and EV_ERR <> 0) then
     CommEvent := CommEvent + [tceErr];
   if (tcePErr in Events) and (EventMask and EV_PERR <> 0) then
     CommEvent := CommEvent + [tcePErr];
   if (tceRing in Events) and (EventMask and EV_RING <> 0) then
     CommEvent := CommEvent + [tceRing];
   if (tceRlsd in Events) and (EventMask and EV_RLSD <> 0) then
     CommEvent := CommEvent + [tceRlsd];
   if (tceRlsds in Events) and (EventMask and EV_Rlsds <> 0) then
     CommEvent := CommEvent + [tceRlsds];
   if (tceRxChar in Events) and (EventMask and EV_RXCHAR <> 0) then
     CommEvent := CommEvent + [tceRxChar];
   if (tceRxFlag in Events) and (EventMask and EV_RXFLAG <> 0) then
     CommEvent := CommEvent + [tceRxFlag];
   if (tceTxEmpty in Events) and (EventMask and EV_TXEMPTY <> 0) then
     CommEvent := CommEvent + [tceTxEmpty];
   FOnEvent(Self, CommEvent);
 end;
 
 procedure TComm.DoReceive;
 var
 
   Stat: TComStat;
 begin
 
   if (hComm < 0) or not Assigned(FOnReceive) then
     exit;
   GetCommError(hComm, Stat);
   FOnReceive(Self, Stat.cbInQue);
   GetCommError(hComm, Stat);
 end;
 
 procedure TComm.DoTransmit;
 var
   Stat: TComStat;
 begin
   if (hComm < 0) or not Assigned(FOnTransmit) then
     exit;
   GetCommError(hComm, Stat);
   FOnTransmit(Self, Stat.cbOutQue);
 end;
 
 procedure TComm.Loaded;
 begin
   inherited Loaded;
   HasBeenLoaded := True;
   SetPort(FPort);
 end;
 
 constructor TComm.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FWindowHandle := AllocateHWnd(WndProc);
   HasBeenLoaded := False;
   Error := False;
   FPort := PortDefault;
   FBaudRate := BaudRateDefault;
   FParity := ParityDefault;
   FDataBits := DataBitsDefault;
   FStopBits := StopBitsDefault;
   FWriteBufferSize := WriteBufferSizeDefault;
   FReadBufferSize := ReadBufferSizeDefault;
   FRxFull := RxFullDefault;
   FTxLow := TxLowDefault;
   FEvents := EventsDefault;
   hComm := -1;
 end;
 
 destructor TComm.Destroy;
 begin
   DeallocatehWnd(FWindowHandle);
   if hComm >= 0 then
     CloseComm(hComm);
   inherited Destroy;
 end;
 
 procedure TComm.Write(Data: PChar; Len: Word);
 begin
   if hComm < 0 then
     exit;
   if WriteComm(hComm, Data, Len) < 0 then
     Error := True;
   GetCommEventMask(hComm, Integer($FFFF));
 end;
 
 procedure TComm.Read(Data: PChar; Len: Word);
 begin
   if hComm < 0 then
     exit;
   if ReadComm(hComm, Data, Len) < 0 then
     Error := True;
   GetCommEventMask(hComm, Integer($FFFF));
 end;
 
 function TComm.IsError: Boolean;
 begin
   IsError := Error;
   Error := False;
 end;
 
 procedure Register;
 begin
   RegisterComponents('Additional', [TComm]);
 end;
 
 end.
 




Как при проигрывании музыки с Audio CD показывать сколько прошло минут и секунд


 uses
   MMSystem;
 
 procedure TForm1.Timer1Timer(Sender: TObject);
 var
   Trk : Word;
   Min : Word;
   Sec : Word;
 begin
   with MediaPlayer1 do
   begin
     Trk := MCI_TMSF_TRACK(Position);
     Min := MCI_TMSF_MINUTE(Position);
     Sec := MCI_TMSF_SECOND(Position);
     Label1.Caption := Format('%.2d',[Trk]);
     Label2.Caption := Format('%.2d:%.2d',[Min,Sec]);
   end;
 end;
 




Как можно автоматически опpеделить кодиpовкy текста

Ещё pаз:

Смотpи: (Кол-во насчитанных бyков)
А:241790 Б:45768 В:131582 Г:36392 Д:90944 Е:286883 Ж:27470 З:53187
И:221390 Й:35677 К:102705 Л:116371 М:115467 H:185044 О:304716 П:104408
Р:157473 С:143929 Т:202411 У:69038 Ф:14771 Х:19930 Ц:17906 Ч:34798
Ш:9739 Щ:18389 Ъ:4830 Ы:70756 Ь:41913 Э:12354 Ю:23026 Я:67180

(Кол-во насчитанных бyков, отсоpтиpовано)
О:304716 Е:286883 А:241790 И:221390 Т:202411 H:185044 Р:157473 С:143929
В:131582 Л:116371 М:115467 П:104408 К:102705 Д:90944 Ы:70756 У:69038
Я:67180 З:53187 Б:45768 Ь:41913 Г:36392 Й:35677 Ч:34798 Ж:27470
Ю:23026 Х:19930 Щ:18389 Ц:17906 Ф:14771 Э:12354 Ш:9739 Ъ:4830

(Кол-во насчитанных бyков, отсоpтиpовано и pасфасовано)
Гласные:
О:304716 Е:286883 А:241790 И:221390 Ы:70756 У:69038 Я:67180 Й:35677
Э:12354 Ю:23026

Согласные:
Т:202411 H:185044 Р:157473 С:143929 В:131582 Л:116371 М:115467 П:104408
К:102705 Д:90944 З:53187 Б:45768 Г:36392 Ч:34798 Ж:27470 Х:19930
Щ:18389 Ц:17906 Ф:14771 Ш:9739

Фиг знает какие:
Ь:41913 Ъ:4830

Чаще всего встpечаются бyквы: 'ОТЕHАР'

Тепеpь пеpекодиpовка


 type
   TCoding = array[Char] of Char;
 
 const
   DTW := TCoding(Dos - > Win
     #$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07,
     #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F,
     #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17,
     #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F,
     #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27,
     #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F,
     #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37,
     #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F,
     #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47,
     #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F,
     #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57,
     #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F,
     #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67,
     #$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F,
     #$70, #$71, #$72, #$73, #$74, #$75, #$76, #$77,
     #$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F,
     #$C0, #$C1, #$C2, #$C3, #$C4, #$C5, #$C6, #$C7,
     #$C8, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE, #$CF,
     #$D0, #$D1, #$D2, #$D3, #$D4, #$D5, #$D6, #$D7,
     #$D8, #$D9, #$DA, #$DB, #$DC, #$DD, #$DE, #$DF,
     #$E0, #$E1, #$E2, #$E3, #$E4, #$E5, #$E6, #$E7,
     #$E8, #$E9, #$EA, #$EB, #$EC, #$ED, #$EE, #$EF,
     #$80, #$81, #$82, #$83, #$84, #$C1, #$C2, #$C0,
     #$A9, #$85, #$86, #$87, #$88, #$A2, #$A5, #$89,
     #$8A, #$8B, #$8C, #$8D, #$8E, #$8F, #$E3, #$C3,
     #$90, #$93, #$94, #$95, #$96, #$97, #$98, #$A4,
     #$F0, #$D0, #$CA, #$CB, #$C8, #$D7, #$CD, #$CE,
     #$CF, #$99, #$9A, #$9B, #$9C, #$A6, #$CC, #$9D,
     #$F0, #$F1, #$F2, #$F3, #$F4, #$F5, #$F6, #$F7,
     #$F8, #$F9, #$FA, #$FB, #$FC, #$FD, #$FE, #$FF,
     #$A8, #$B8, #$F7, #$BE, #$B6, #$A7, #$9F, #$B8,
     #$B0, #$A8, #$B7, #$B9, #$B3, #$B2, #$9E, #$A0);
 
   WTD: TCoding = (Win - > Dos
     #$00, #$01, #$02, #$03, #$04, #$05, #$06, #$07,
     #$08, #$09, #$0A, #$0B, #$0C, #$0D, #$0E, #$0F,
     #$10, #$11, #$12, #$13, #$14, #$15, #$16, #$17,
     #$18, #$19, #$1A, #$1B, #$1C, #$1D, #$1E, #$1F,
     #$20, #$21, #$22, #$23, #$24, #$25, #$26, #$27,
     #$28, #$29, #$2A, #$2B, #$2C, #$2D, #$2E, #$2F,
     #$30, #$31, #$32, #$33, #$34, #$35, #$36, #$37,
     #$38, #$39, #$3A, #$3B, #$3C, #$3D, #$3E, #$3F,
     #$40, #$41, #$42, #$43, #$44, #$45, #$46, #$47,
     #$48, #$49, #$4A, #$4B, #$4C, #$4D, #$4E, #$4F,
     #$50, #$51, #$52, #$53, #$54, #$55, #$56, #$57,
     #$58, #$59, #$5A, #$5B, #$5C, #$5D, #$5E, #$5F,
     #$60, #$61, #$62, #$63, #$64, #$65, #$66, #$67,
     #$68, #$69, #$6A, #$6B, #$6C, #$6D, #$6E, #$6F,
     #$70, #$71#$78, #$79, #$7A, #$7B, #$7C, #$7D, #$7E, #$7F,
     #$B0, #$B1, #$B2, #$B3, #$B4, #$B5, #$B6, #$B7,
     #$B8, #$B9, #$BA, #$BB, #$BC, #$BD, #$BE, #$BF,
     #$C0, #$C1, #$C2, #$C3, #$C4, #$C5, #$C6, #$C7,
     #$C8, #$C9, #$CA, #$CB, #$CC, #$CD, #$CE, #$CF,
     #$D0, #$D1, #$D2, #$D3, #$D4, #$D5, #$D6, #$D7,
     #$F0, #$D9, #$DA, #$DB, #$DC, #$DD, #$DE, #$DF,
     #$F0, #$F1, #$F2, #$F3, #$F4, #$F5, #$F6, #$F7,
     #$F1, #$F9, #$FA, #$FB, #$FC, #$FD, #$FE, #$FF,
     #$80, #$81, #$82, #$83, #$84, #$85, #$86, #$87,
     #$88, #$89, #$8A, #$8B, #$8C, #$8D, #$8E, #$8F,
     #$90, #$91, #$92, #$93, #$94, #$95, #$96, #$97,
     #$98, #$99, #$9A, #$9B, #$9C, #$9D, #$9E, #$9F,
     #$A0, #$A1, #$A2, #$A3, #$A4, #$A5, #$A6, #$A7,
     #$A8, #$A9, #$AA, #$AB, #$AC, #$AD, #$AE, #$AF,
     #$E0, #$E1, #$E2, #$E3, #$E4, #$E5, #$E6, #$E7,
     #$E8, #$E9, #$EA, #$EB, #$EC, #$ED, #$EE, #$EF);
 
   {Тепеpь сам пpоцесс подсч?та!}
 type
   TCounts = array[Char] of LongInt;
 
 var
   WinCounts: TCounts;
   DosCounts: TCounts;
 
   {Очистка}
 
 procedure ClearCoding;
 var
   c: Char;
 begin
   for c := #1 to #$FF do
   begin
     WinCounts[c] := 0;
     DosCounts[c] := 0;
   end;
 end;
 
 {Подсч?т}
 
 procedure CalcString(const S: string);
 var
   i: LongInt;
 begin
   for i := 1 to LenGth(s) do
   begin
     {Если в Delphi}
     Inc(WinCounts[S[i]]);
     Inc(DosCounts[DTW[S[i]]]);
 
     {Если в Turbo Pascal
     Inc(WinCounts[WTD[S[i]]]);
     Inc(DosCounts[S[i]]);
     }
   end;
 end;
 
 function TestWinCode: Boolean;
 begin
   TestWinCode :=
     (WinCounts['О'] + WinCounts['Т'] + WinCounts['Е'] + WinCounts['H']) >=
     (DosCounts['О'] + DosCounts['Т'] + DosCounts['Е'] + DosCounts['H']);
 end;
 
 function TestDosCode: Boolean;
 begin
   TestDosCode :=
     (WinCounts['О'] + WinCounts['Т'] + WinCounts['Е'] + WinCounts['H']) <
     (DosCounts['О'] + DosCounts['Т'] + DosCounts['Е'] + DosCounts['H']);
 end;
 { *----------------Откyда-вс?-это-???-------------------------* }
 { Можно yбpать последние тpи слагаемые, y меня и так pаботало }
 { Опpеделяет по одномy словy, если там есть хотя бы одна бyква }
 { Можно также сделать по всем бyквам и искать pасстояния в 256 }
 { меpном пpостpанстве, но это я делал, когда символы были за- }
 { шифpованы чеpез Xor или Add Const, а там, пpости, 256 ваpи- }
 { антов, а не два. И то y меня по одномy словy вс? понимала, }
 { только pедкие не понимала, но пpедложения точно понимала! }
 { *-----------------------------------------------------------* }
 
 { *-------------------UpGread---------------------------------* }
 { Можно доpаботать пpогpаммy для игноpиpования повтоpяющихся }
 { последовательностей }
 { *-----------------------------------------------------------* }
 
 
 {Пpимеp использования}
 _Var_
   S: _String_;
   f: Text;
 _Begin_
   Assign(f, 'Test.txt');
   Reset(f);
   ClearCoding;
   _Repeat_
     ReadLn(f, S);
     CalcString(S);
   _Until_
     EOF(f);
   Close(f);
   _If_ TestWinCode _Then_
     {Виндовская кодиpовка}
   _If_ TestDosCode _Then_
     {Досовская кодиpовка}
 _End_;
 




Автоматическое определения кодировки текста

Автор: Stas Malinovski

<АБЫРВАЛГ!>, сказал линyкс после русификации.

Методом таблицы модельных распределений:


 type
   TCodePage = (cpWin1251, cp866, cpKOI8R);
   PMap = ^TMap;
   TMap = array[#$80..#$FF] of Char;
 
 function GetMap(CP: TCodePage): PMap;
 { должна возвращать указатель на таблицу перекодировки из CP в Windows1251
 (nil для CP = cpWin1251) }
 begin
   GetMap := nil;
 end;
 
 function DetermineRussian(Buf: PChar; Count: Integer): TCodePage;
 const
   ModelBigrams: array[0..33, 0..33] of Byte = (
     {АБВГДЕЖЗИЙКЛМHОПРСТУФХЦЧШЩЪЫЬЭЮЯ_?}
     {А}(0, 20, 44, 12, 22, 23, 16, 60, 4, 9, 63, 93, 47, 110, 0, 16, 35, 61, 81,
       1, 5, 13, 24, 17, 12, 4, 0, 0, 0, 0, 14, 31, 205, 1),
     {Б}(19, 0, 0, 0, 4, 19, 0, 0, 8, 0, 2, 15, 1, 4, 41, 0, 15, 5, 0, 15, 0, 2,
       1, 0, 0, 6, 16, 37, 0, 0, 0, 4, 3, 0),
     {В}(97, 0, 1, 0, 2, 57, 0, 5, 40, 0, 4, 25, 2, 23, 78, 2, 8, 28, 4, 12, 0,
       1, 0, 0, 8, 1, 0, 40, 1, 0, 0, 5, 106, 3),
     {Г}(13, 0, 0, 0, 9, 5, 0, 0, 15, 0, 1, 17, 1, 2, 96, 0, 24, 0, 0, 7, 0, 0,
       0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 8, 0),
     {Д}(63, 0, 9, 1, 2, 71, 1, 0, 35, 0, 3, 16, 2, 22, 50, 2, 19, 9, 2, 25, 0,
       2, 1, 0, 1, 0, 1, 9, 4, 0, 1, 5, 17, 4),
     {Е}(4, 14, 15, 34, 56, 22, 13, 14, 2, 34, 39, 77, 73, 150, 6, 9, 101, 64,
       81, 1, 0, 15, 5, 12, 10, 6, 0, 0, 0, 0, 3, 4, 235, 1),
     {Ж}(13, 0, 0, 0, 12, 47, 0, 0, 16, 0, 1, 0, 0, 23, 0, 0, 0, 0, 0, 3, 0, 0,
       0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 2, 2),
     {З}(76, 2, 11, 3, 11, 4, 1, 0, 7, 0, 2, 4, 11, 24, 17, 0, 6, 1, 0, 8, 0, 0,
       0, 0, 0, 0, 0, 16, 6, 0, 1, 4, 17, 0),
     {И}(7, 9, 32, 5, 18, 60, 4, 42, 31, 27, 28, 46, 55, 49, 12, 7, 26, 60, 53,
       0, 5, 25, 14, 28, 4, 1, 0, 0, 0, 0, 9, 56, 255, 0),
     {Й}(0, 0, 0, 0, 2, 0, 0, 0, 0, 0, 1, 3, 0, 3, 0, 0, 0, 10, 3, 0, 0, 0, 0, 1,
       1, 0, 0, 0, 0, 0, 0, 0, 122, 0),
     {К}(92, 0, 3, 0, 0, 7, 2, 1, 39, 0, 0, 27, 0, 14, 110, 0, 18, 5, 35, 18, 0,
       0, 11, 0, 0, 0, 0, 0, 0, 0, 0, 0, 5, 5, 0),
     {Л}(85, 1, 0, 2, 1, 70, 6, 0, 85, 0, 5, 3, 0, 9, 67, 1, 0, 9, 0, 15, 0, 0,
       0, 2, 0, 0, 0, 9, 66, 0, 15, 43, 57, 4),
     {М}(44, 0, 0, 0, 0, 65, 0, 0, 47, 0, 1, 1, 10, 15, 57, 7, 0, 2, 0, 24, 0, 0,
       0, 0, 0, 0, 0, 28, 0, 0, 0, 8, 109, 3),
     {}(139, 0, 0, 1, 11, 108, 0, 4, 152, 0, 7, 0, 1, 69, 161, 0, 0, 8, 25, 24,
       5, 1, 5, 2, 0, 1, 0, 83, 10, 0, 1, 29, 38, 5),
     {О}(0, 72, 139, 76, 74, 32, 32, 19, 12, 52, 21, 93, 68, 72, 7, 34, 93, 102,
       98, 1, 2, 6, 6, 19, 15, 2, 0, 0, 0, 1, 4, 9, 252, 2),
     {П}(17, 0, 0, 0, 0, 43, 0, 0, 14, 0, 1, 9, 0, 1, 125, 3, 120, 1, 2, 8, 0, 0,
       0, 0, 0, 0, 0, 3, 6, 0, 0, 3, 2, 2),
     {Р}(151, 1, 6, 4, 3, 103, 7, 0, 76, 0, 4, 0, 11, 10, 117, 1, 0, 5, 9, 39, 2,
       5, 0, 1, 3, 0, 0, 24, 7, 0, 1, 10, 22, 5),
     {С}(24, 1, 21, 0, 3, 39, 0, 0, 33, 0, 56, 41, 11, 15, 58, 30, 5, 30, 183,
       16, 0, 4, 1, 4, 1, 0, 0, 8, 25, 0, 1, 50, 41, 2),
     {Т}(83, 0, 43, 0, 3, 87, 0, 0, 71, 0, 9, 3, 2, 26, 180, 0, 55, 33, 1, 23, 1,
       0, 1, 4, 0, 0, 0, 20, 78, 0, 0, 5, 82, 4),
     {У}(3, 6, 7, 14, 19, 8, 13, 6, 0, 1, 13, 15, 10, 7, 0, 12, 17, 16, 19, 0, 1,
       3, 0, 12, 5, 8, 0, 0, 0, 0, 22, 1, 65, 0),
     {Ф}(4, 0, 0, 0, 0, 4, 0, 0, 11, 0, 0, 1, 0, 0, 9, 0, 3, 0, 0, 4, 1, 0, 0, 0,
       0, 0, 0, 0, 0, 0, 0, 0, 2, 0),
     {Х}(9, 0, 2, 0, 0, 2, 0, 0, 5, 0, 0, 1, 0, 5, 26, 0, 4, 1, 0, 1, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 0, 0, 0, 76, 0),
     {Ц}(5, 0, 0, 0, 0, 16, 0, 0, 48, 0, 1, 0, 0, 0, 4, 0, 0, 0, 0, 3, 0, 0, 0,
       0, 0, 0, 0, 2, 0, 0, 0, 0, 3, 0),
     {Ч}(30, 0, 0, 0, 0, 52, 0, 0, 23, 0, 3, 1, 0, 14, 1, 0, 0, 0, 36, 5, 0, 0,
       0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 2, 2),
     {Ш}(13, 0, 0, 0, 0, 28, 0, 0, 17, 0, 4, 4, 0, 4, 3, 0, 0, 0, 1, 3, 0, 0, 0,
       0, 0, 0, 0, 0, 3, 0, 0, 0, 1, 1),
     {Щ}(6, 0, 0, 0, 0, 23, 0, 0, 16, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0,
       0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1),
     {Ъ}(0, 0, 0, 0, 0, 16, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 0, 1, 1, 0, 0),
     {Ы}(0, 5, 14, 1, 3, 28, 0, 2, 0, 22, 6, 19, 21, 2, 0, 5, 4, 7, 10, 0, 0, 37,
       0, 3, 4, 0, 0, 0, 0, 0, 0, 1, 84, 0),
     {Ь}(0, 1, 0, 0, 0, 9, 0, 10, 1, 0, 13, 0, 2, 26, 0, 0, 0, 10, 3, 0, 0, 0, 1,
       0, 6, 0, 0, 0, 0, 0, 6, 4, 117, 0),
     {Э}(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 3, 3, 0, 0, 0, 0, 0, 0, 31, 0, 1, 0, 0, 0,
       0, 0, 0, 0, 0, 0, 0, 0, 0, 0),
     {Ю}(0, 5, 0, 0, 3, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 15, 0, 0, 0, 1, 4,
       1, 15, 0, 0, 0, 0, 0, 0, 38, 0),
     {Я}(0, 0, 9, 2, 7, 10, 3, 19, 0, 0, 1, 6, 7, 8, 0, 0, 2, 6, 19, 0, 0, 3, 5,
       1, 0, 3, 0, 0, 0, 0, 5, 2, 177, 0),
     {_}(42, 80, 193, 43, 109, 41, 18, 53, 159, 0, 144, 27, 83, 176, 187, 229,
       70, 231, 99, 47, 15, 13, 6, 58, 7, 0, 0, 0, 0, 38, 0, 22, 0, 2),
     {?}(0, 0, 0, 0, 3, 0, 0, 0, 0, 0, 2, 4, 4, 8, 0, 0, 5, 3, 4, 0, 0, 0, 0, 0,
       0, 0, 0, 0, 0, 0, 0, 0, 0, 0));
   { " рейтинг"  буквы ? условно принимается равным 1/20 от " рейтинга"  буквы E,
   если сочетание с участием ? корректно, иначе - 0 }
 type
   TVariation = array[0..33, 0..33] of Integer;
 var
   I, J, iC, iPredC, Max: Integer;
   C: Char;
   CP: TCodePage;
   D, MinD, Factor: Double;
   AMap: PMap;
   PV: ^TVariation;
   Vars: array[TCodePage] of TVariation;
 begin
   DetermineRussian := cpWin1251; { по yмолчанию }
   { вычисление распределений биграмм }
   FillChar(Vars, SizeOf(Vars), 0);
   for CP := Low(Vars) to High(Vars) do
   begin
     AMap := GetMap(CP);
     PV := @Vars[CP];
     iPredC := 32;
     for I := 0 to Count - 1 do
     begin
       C := Buf[I];
       iC := 32;
       if C > = #128 then
       begin
         if AMap < > nil then
           C := AMap^[C];
         if not (C in ['?', '?']) then
         begin
           C := Chr(Ord(C) and not 32); { 'a'..'я' ->  'А'..'Я' }
           if C in ['А'..'Я'] then
             iC := Ord(C) - Ord('А');
         end
         else
           iC := 33;
       end;
       Inc(PV^[iPredC, iC]);
       iPredC := iC;
     end;
   end;
   { вычисление метрики и определение наиболее правдоподобной кодировки }
   MinD := 0;
   for CP := Low(Vars) to High(Vars) do
   begin
     PV := @Vars[CP];
     PV^[32, 32] := 0;
     Max := 1;
     for I := 0 to 33 do
       for J := 0 to 33 do
         if PV^[I, J] > Max then
           Max := PV^[I, J];
     Factor := 255 / Max; { ноpмализация }
     D := 0;
     for I := 0 to 33 do
       for J := 0 to 33 do
         D := D + Abs(PV^[I, J] * Factor - ModelBigrams[I, J]);
     if (MinD = 0) or (D < MinD) then
     begin
       MinD := D;
       DetermineRussian := CP;
     end;
   end;
 end;
 
 begin
   { тест: слово 'Пример' в разных кодировках (веpоятность ошибок на таких
   коpотких текстах высока - в данном слyчае пpосто повезло!) }
   writeln(DetermineRussian(#$CF#$F0#$E8#$EC#$E5#$F0, 6) = cpWin1251);
   writeln(DetermineRussian(#$8F#$E0#$A8#$AC#$A5#$E0, 6) = cp866);
   writeln(DetermineRussian(#$F0#$D2#$C9#$CD#$C5#$D2, 6) = cpKOI8R);
   readln;
 end.
 




Автозаполнение в ComboBox


 {
   Ever wondered how to make a combobox
   with autocomplete like the one in the explorer?
   The trick is in the CB_FINDSTRING API call.
 }
 
 
 var
   LastKey: Word;
 
 procedure TForm1.ComboBox1KeyDown(Sender: TObject; var Key: Word;
   Shift: TShiftState);
 begin
   LastKey := Key;
 end;
 
 procedure TForm1.ComboBox1Change(Sender: TObject);
 var
   Srch: string;
   ix: Integer;
 begin
   Srch := combobox1.Text;
   if LastKey = $08 then
   begin
     LastKey := 0;
     Exit;
   end;
   LastKey := 0;
   ix := combobox1.Perform(CB_FINDSTRING, - 1, Longint(PChar(Srch)));
   if ix > CB_ERR then
   begin
     combobox1.ItemIndex := ix;
     combobox1.SelStart  := Length(Srch);
     combobox1.SelLength := (Length(combobox1.Text) - Length(Srch));
   end;
 end;
 




Как автоматически расширить TEdit

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

Следующий компонент автоматически подстраивается под текст, вводимый в него:


 unit ExpandingEdit;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
   Dialogs, StdCtrls;
 
 type
   TExpandingEdit = class(TEdit)
   private
     FCanvas: TControlCanvas;
   protected
     procedure Change; override;
   public
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
 end;
 
 procedure register;
 
 implementation
 
 constructor TExpandingEdit.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   FCanvas := TControlCanvas.Create;
   FCanvas.Control := Self;
 end;
 
 destructor TExpandingEdit.Destroy;
 begin
   FCanvas.Free;
   inherited Destroy;
 end;
 
 procedure TExpandingEdit.Change;
 const
   EditMargin = 8;
 var
   W: Integer;
 begin
   inherited Change;
   if not HandleAllocated then
     Exit;
   FCanvas.Font := Font;
   W := FCanvas.TextWidth(Text) + (2 * EditMargin);
   if (Width < W) then
     Width := W;
 end;
 
 procedure register;
 begin
   RegisterComponents('Samples', [TExpandingEdit]);
 end;
 
 end.
 




Как автоматически отправлять E-mail


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

В следующем примере E-mail отправляется автоматически сразу после нажатия кнопки.

Вам потребуется компонент 'TNMSMTP'. Этот компонент входит в поставляется с Delphi 4 и 5 и его можно найти на закладке 'Fastnet'.


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   with NMSMTP1 do
   begin
     Host := 'smtp.mailserver.com';
     UserID := '___Nikolay';
     Connect;
 
     PostMessage.FromAddress := 'DelphiWorld@mail.ru';
     PostMessage.ToAddress.Text := 'bestprogramming@mail.ru';
     PostMessage.Body.Text := 'Текст письма';
     PostMessage.Subject := 'Тема письма';
     SendMail;
   end;
 end;
 




Процедура автоматического масштабирования формы под разрешение экрана

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

Эта подпрограмма сделает жизнь программиста намного легче. Она делает так, чтобы ваша программа корректно масштабировалась при ЛЮБОМ разрешении экрана. Обратите внимание на число 640. Дело в том, что я разрабатываю свои приложения при разрешении 640x480. Вы можете настроить подпрограмму на ваше экранное разрешение при разработке программ и больше не беспокоиться о всевозможных низких и больших разрешений ваших пользователей. Разместите в обработчике события формы (которую вы хотите автомасштабировать) OnCreate следующую строку:


 AdjustResolution(Self);
 


 { AdjustResolution ******************************************************* }
 { Данная процедура масштабирует все дочерние формы данной формы для        }
 { соответствия текущему разрешению                                         }
 { ************************************************************************ }
 procedure AdjustResolution(oForm:TForm);
 var
   iPercentage:integer;
 begin
   if Screen.Width > 640 then
   begin
     iPercentage:=Round(((Screen.Width-640)/640)*100)+100;
     oForm.ScaleBy(iPercentage,100);
   end;
 end;
 




Автоматически нажимающаяся кнопка

Этот компонент представляет из себя кнопку, на которую не надо нажимать, чтобы получить событие OnClick. Достаточно переместить курсор мышки на кнопку. При создании такого компонента традиционным способом, требуется довольно много времени, так как необходимо обрабатывать мышку, перехватывать её и т.д. Однако результат стоит того!

Предлагаю взглянуть на две версии данного компонента. В более простой версии обработчик перемещения мышки просто перехватывает сообщения Windows с нужным кодом и вызывает обработчик события OnClick:


 type
   TAutoButton1 = class(TButton)
   private
     procedure WmMouseMove(var Msg: TMessage); message wm_MouseMove;
 end;
 
 procedure TAutoButton1.WmMouseMove(var Msg: TMessage);
 begin
   inherited;
   if Assigned(OnClick) then
     OnClick(self);
 end;
 

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


 type
   TAutoKind = (akTime, akMovement, akBoth);
 
   TAutoButton2 = class(TButton)
   private
     FAutoKind: TAutoKind;
     FMovements: Integer;
     FSeconds: Integer;
     // really private
     CurrMov: Integer;
     Capture: Boolean;
     MyTimer: TTimer;
     procedure EndCapture;
     // обработчики сообщений
     procedure WmMouseMove (var Msg: TWMMouse); message wm_MouseMove;
     procedure TimerProc (Sender: TObject);
     procedure WmLBUttonDown (var Msg: TMessage); message wm_LBUttonDown;
     procedure WmLButtonUp (var Msg: TMessage); message wm_LButtonUp;
   public
     constructor Create (AOwner: TComponent); override;
   published
     property AutoKind: TAutoKind read FAutoKind write FAutoKind default akTime;
     property Movements: Integer read FMovements write FMovements default 5;
     property Seconds: Integer read FSeconds write FSeconds default 10;
 end;
 

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


 procedure TAutoButton2.WmMouseMove (var Msg: TWMMouse);
 begin
   inherited;
   if not Capture then
   begin
     SetCapture (Handle);
     Capture := True;
     CurrMov := 0;
     if FAutoKind <> akMovement then
     begin
       MyTimer := TTimer.Create (Parent);
       if FSeconds <> 0 then
         MyTimer.Interval := 3000
       else
         MyTimer.Interval := FSeconds * 1000;
       MyTimer.OnTimer := TimerProc;
       MyTimer.Enabled := True;
     end;
   end
   else // захватываем
   begin
     if (Msg.XPos > 0) and (Msg.XPos < Width) and (Msg.YPos > 0) and (Msg.YPos < Height) then
     begin
       // если мы подсчитываем кол-во движений...
       if FAutoKind <> akTime then
       begin
         Inc (CurrMov);
         if CurrMov >= FMovements then
         begin
           if Assigned (OnClick) then
             OnClick (self);
           EndCapture;
         end;
       end;
     end
     else // за пределами... стоп!
       EndCapture;
   end;
 end;
 
 procedure TAutoButton2.EndCapture;
 begin
   Capture := False;
   ReleaseCapture;
   if Assigned (MyTimer) then
   begin
     MyTimer.Enabled := False;
     MyTimer.Free;
     MyTimer := nil;
   end;
 end;
 
 procedure TAutoButton2.TimerProc (Sender: TObject);
 begin
   if Assigned (OnClick) then
     OnClick (self);
   EndCapture;
 end;
 
 procedure TAutoButton2.WmLBUttonDown (var Msg: TMessage);
 begin
   if not Capture then
     inherited;
 end;
 
 procedure TAutoButton2.WmLButtonUp (var Msg: TMessage);
 begin
   if not Capture then
     inherited;
 end;
 




Автоматический выбор произвольного пункта PopupMenu

Автор: Aleksey


 {Так можно заставить сразу, после появления на экране
 PopupMenu, автоматически выбирать произвольный пункт.}
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   I, N: Integer;
 begin
   N := 3; {номер по порядку}
   for I := 1 to N do
     PostMessage(Self.Handle, WM_KeyDown, VK_DOWN, 0);
 end;
 




Как проиграть AVI на полный экран

Автор: Олег Кулабухов

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

Просто проиграть его на другой форме, развернутой на весь экран


 {Code for Form 1}
 
 uses Unit2;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Form2.Show;
   Form2.WindowState := wsMaximized;
   Form2.MediaPlayer1.Notify := false;
   Form2.MediaPlayer1.Display := Form2.Panel1;
   Form2.MediaPlayer1.FileName := 'C:\TheWall\DELCAR2.AVI';
   Form2.MediaPlayer1.Open;
   Form2.MediaPlayer1.DisplayRect := Form2.ClientRect;
   Form2.MediaPlayer1.Play;
 end;
 
 {Code for Form 2}
 
 procedure TForm2.MediaPlayer1Notify(Sender: TObject);
 begin
   if MediaPlayer1.NotifyValue = nvSuccessful then
     Form2.Close;
 end;
 




Проблема циклических ссылок

Автор: Mike Scott

Игра Lines - это стратегия. Только в ней слишком быстро понимаешь, какой из тебя стратег...

У меня имеется объект A и объект B, и им обоим нужно вызывать методы друг друга...

Объявите абстрактный базовый класс, определяющий интерфейс класса для того, чтобы другие классы могли его видеть. Используйте виртуальные абстрактные методы и свойства. Затем объявите другие классы подклассами базового класса (при необходимости). Данный метод существенно поможет в структурировании вашего приложения.




BackDoor - удалённое администрирование 2

Автор: Danil
WEB-сайт: http://www.danil.dp.ua

- В чем заключается многозадачность Windows?
- Она глючит и работает одновременно.

Начнем с отзывов. Во-первых, спасибо за положительные. Во-вторых, я допустил ошибку, а никто и не увидел. Процесс обработки очереди надо все-таки терминайтить. Но об этом далее. В-третьих, комментариев в коде вполне достаточно. Я так пишу. Охоту к написанию комментариев у меня отбили еще в универе. А если не можешь разобраться, так нафига вообще трепыхаться - ходи на порно-сайты и дыши с присвистом. В-четвертых, объясню почему сервер писался на асме. На это есть 6 причин:

  1. Быстродействие. Все равно быстрее будет работать чем на сях и delphi (не говоря уже о тормознутом визуал бейсике. Такой язык надо в школе изучать - это надо ж, грузить dll-и и запускать с них функции);
  2. Размеры. 11 kb "всунуть" в что-то все таки легче чем, например, 100;
  3. Если мы пишем на асме, то имеем дело с ошибками своими и мелкософта, а не с глюками программера из фирмы Borland. Взять хотя-бы "RadioGroup" в Delphi;
  4. В ранних версиях "DTr", периодически возникала ошибка 10060 асинхронной работы. Только на некоторых компьютерах, но все-таки. Написание сервера на сях не помогло. После выхода версии на асме и сооружения в клиенте процесса обработки очереди приходящих сообщений, у меня еще такой ошибки не возникало;
  5. В своих продуктах фирмы по производству программного обеспечения, любят при ошибке вызывать исключительную ситуацию, на что виндоуз реагирует показом "красивого" окошка с сообщением об ошибке. Некоторые такие реакции не подавляются try-except. Для сервера это, мягко сказать, нежелательно. В асме все проще;
  6. Для борьбы с буржуйскими программами с помощью WINdasm, SoftIce и т.п., ассемблер надо знать. А для того чтобы его знать, на нем иногда надо писать. Завести 2-ой комп и бегать, смотреть на одном окно SoftIce, а на другом доки - это сильно круто.

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


 if not RecvThread.Terminated then
 begin
   while not RecvThread.Terminated do
   begin
     try
       RecvThread.Terminate;
     except
     end;
     sleep(100);
     Application.ProcessMessages;
   end;
 end;
 LstRbeg:=nil;
 LstRend:=nil;
 

Также нас интересует событие, происходящее перед выходом из клиента. Выделим нашу форму ("Form1"), перейдем в "Object Inspector" на закладку "Events" и 2 раза "click"-нем по "onClose". Перейдем в раздел кода и запишем:


 // Выход из проги
 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   Action := caNone;
   if constat then
     Form1.Button1Click(Sender);
   Application.ProcessMessages;
   Application.Terminate;
   Halt(1);
 end;
 

Теперь поговорим о визуализации и удобстве работы с клиентом. Кнопки, которые отвечают за посылание серверу команд, надо как-то выделить. Для этого воспользуемся объектом "ImageList" с закладки "Win32" ("ImageList1"). Помещаем его на форму и с помощью правой кнопки мыши добавляем в него изображения для кнопок. Теперь нужно выделить "ToolBar1" и в его свойстве "Images", из всплывающего списка, поставить "ImageList1". После этого перейдем на "ToolButton1", в свойстве "ImageIndex", выберем нужный рисунок. Для отображения "всплывающей" подсказки в свойстве "ShowHint" поставим "true", а в свойстве "Hint", напишем "Кнопка № 1". Очень информативно.

Сканер для сервера.

Допустим, мы знаем, что серверная часть запущена у человека (это звучит гордо), пользующегося услуами провайдера "Slow". Мы также знаем пространство адресов этого провайдера. Но мы не знаем, какой адрес даст провайдер этому челу.

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

Или мы изменили порт, а какой забыли.

Для всего этого нам нужен сканер по адресам и портам. То, о чем пойдет речь далее, можно использовать не только для нашего сервера. Итак, в Delphi, в проекте нашего сервера, выбираем в верхнем меню "File"-->"New Form". Пусть это будет "Form2". В свойстве "Caption" пишем "Сканер". Размещаем на форме компоненты:

Edit1
С какого порта начинать сканирование;
Edit2
По какой порт;
Edit3
Первые 3 цифры адреса в виде "xxx.xxx.xxx.xxx" (без точки в конце);
Edit4, Edit5
Диапазон последней цифры адреса;
Edit6
Время ожидания соединения (в секундах);
Button1
Начать/прекратить сканирование;
Memo1
Отчет сканирования;
ProgressBar1, ProgressBar2 (Win32)
Для визуализации процесса перебора по адресам и портам соответственно;
ClientSocket1
И так понятно.

Теперь на "Form1" лепим кнопку, обзываем ее "Scaner" и нажимаем на ней два раза. В разделе кода пишем :


 // Scaner
 procedure TForm1.Button2Click(Sender: TObject);
 begin
   Form2.WindowState := wsNormal;
   Form2.Visible := true;
   Form2.SetFocus;
 end;
 

В раздел "uses" добавляем "Unit2". Переходим на "Form2". Два раза нажимаем на "Button1", на события "onConnect" и "onError" в "ClientSocket1" и на "onClose" в "Form2". Вот текст модуля "Unit2.pas":


 unit Unit2;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   ComCtrls, StdCtrls, ScktComp;
 
 type
   TForm2 = class(TForm)
   Edit1: TEdit;
   Edit2: TEdit;
   Edit3: TEdit;
   Edit4: TEdit;
   Edit5: TEdit;
   Edit6: TEdit;
   Button1: TButton;
   Memo1: TMemo;
   ProgressBar1: TProgressBar;
   ProgressBar2: TProgressBar;
   ClientSocket1: TClientSocket;
   procedure FormClose(Sender: TObject; var Action: TCloseAction);
   procedure Button1Click(Sender: TObject);
   procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
   procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
   private
     { Private declarations }
   public
     { Public declarations }
 end;
 
 var
   Form2: TForm2;
   Rez11: Boolean = false;
   Bool: Boolean = false;
 
 implementation
 
 {$R *.DFM}
 
 //Close Scaner
 procedure TForm2.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   // если запущен, то прерываем процесс
   if Rez11 then
   begin
     Action := caNone;
     Form2.Button1Click(Sender);
   end;
 end;
 
 // Включить/отключить сканер
 procedure TForm2.Button1Click(Sender: TObject);
 var
   I, J, K: Integer;
   DopStr: string;
 begin
   if Rez11 then
   begin
     // прервать сканирование
     if Application.MessageBox('Прервать сканирование?', 'Сканер', mb_YesNo + mb_IconQuestion) = idYes then
     begin
       Rez11 := false;
       Bool := false;
     end;
   end
   else
   begin
     // запуск сканера
     if StrToInt(Form2.Edit2.Text) < StrToInt(Form2.Edit1.Text) then
     begin
       Application.MessageBox('Неверно указан диапазон для портов','Сканер', mb_Ok + mb_IconStop);
       exit;
     end;
 
     if StrToInt(Form2.Edit5.Text) < StrToInt(Form2.Edit4.Text) then
     begin
       Application.MessageBox('Неверно указан диапазон IP-адресов','Сканер', mb_Ok + mb_IconStop);
       exit;
     end;
 
     Form2.Caption:='Идет сканирование...';
     Form2.Memo1.Lines.Clear;
 
     try
       DopStr := trim(Form2.Edit3.Text);
       Rez11 := true;
       Form2.Button1.Caption := 'Отмена';
       Form2.Memo1.Lines.Add('-------------' + #13 + #10 + '===========');
 
       // начальные значения для порта и адреса
       I := StrToInt(Form2.Edit1.Text);
       J := StrToInt(Form2.Edit4.Text);
 
       try
         Form2.ProgressBar1.Max := StrToInt(Form2.Edit2.Text) - StrToInt(Form2.Edit2.Text) + 2;
         Form2.ProgressBar1.Position := 1;
         Form2.ProgressBar2.Max := StrToInt(Form2.Edit5.Text) - StrToInt(Form2.Edit4.Text) + 2;
         Form2.ProgressBar2.Position := 1;
 
         // цикл по адресам
         while I <= StrToInt(Form2.Edit2.Text) do
         begin
           J := StrToInt(Form2.Edit4.Text);
           // цикл по портам
           while J <= StrToInt(Form2.Edit5.Text) do
           begin
             Application.ProcessMessages;
             if not Rez11 then
               break;
             Form2.ClientSocket1.Active := false;
             Form2.ClientSocket1.Port := I;
             Form2.ClientSocket1.Address := trim(DopStr) + '.' + trim(IntToStr(J));
 
             try
               // попытка соедениться
               Form2.ClientSocket1.Active := true;
               Application.ProcessMessages;
 
               // время ожидания
               Bool := true;
               K := round(StrToInt(Form2.Edit6.Text) * 1000 / 50);
               while Bool do
               begin
                 Sleep(50);
                 Application.ProcessMessages;
                 dec(K);
                 if K=0 then
                 begin
 
                   try
                     Form2.ClientSocket1.Active:=false;
                   except
                   end;
                   break;
                 end;
               end;
             except
             end;
 
             Application.ProcessMessages;
             Form2.ProgressBar2.Position := Form2.ProgressBar2.Position + 1;
             inc(J);
           end;
           inc(I);
           Application.ProcessMessages;
 
           if not Rez11 then
             break;
 
           Form2.ProgressBar1.Position := Form2.ProgressBar1.Position + 1;
         end;
         Form2.ProgressBar2.Position := Form2.ProgressBar1.Position + 1;
         Form2.ProgressBar1.Position := Form2.ProgressBar1.Position + 1;
       except
         Application.MessageBox('Ошибка выполнения операции', 'Сканер', MB_Ok + mb_IconStop);
       end;
       Form2.Button1.Caption := 'Сканер';
       Form2.ProgressBar1.Position := 0;
       Form2.ProgressBar2.Position := 0;
       Form2.Caption := 'Сканер по адресам и портам';
       if Rez11 then
       begin
         Application.MessageBox('Процедура сканирования по адресам и портам закончена.', 'Сканер', mb_Ok + mb_IconAsterisk);
         Form2.Memo1.Lines.Add('-----------------'+#13+#10+'========== ВСЕ АДРЕСА И ПОРТЫ ОТСКАНИРОВАНЫ'+#13+#10+#13+#10);
         Rez11 := false;
       end
       else
         Form2.Memo1.Lines.Add('------------'+#13+#10+'============== ПРЕРВАНО НА порт-'+IntToStr(I)+', адрес-'+trim(DopStr)+'.'+IntToStr(J-1)+#13+#10+#13+#10);
     except
       Application.MessageBox('Ошибка инициализации процесса.','Сканер',mb_Ok+mb_IconStop);
     end;
     Form2.Caption:='Сканер по адресам и портам';
   end;
 end;
 
 // Есть ответ сервера
 procedure TForm2.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket);
 begin
   // если соеденились вывести сообщение
   Form2.Memo1.Lines.Add('***' + #13 + #10 + 'Порт: ' + IntToStr(Form2.ClientSocket1.Port) + ' ' + 'Адрес: ' + Form2.ClientSocket1.Address + ' - ЕСТЬ ОТВЕТ' + #13 + #10);
   Application.ProcessMessages;
   // прервать время ожидания
   try
     Form2.ClientSocket1.Active := false;
   except
   end;
   Bool := false;
 end;
 
 // Ошибка при соединении
 procedure TForm2.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer);
 begin
   // прервать время ожидания если ошибка
   ErrorCode := 0;
   Bool := false;
 end;
 
 end.
 

Теперь проверим. Запускаем сервер и клиент. Жмем кнопку "Сканер". В "Edit1" пишем "10001", в "Edit2" - "10001", в "Edit3" - "127.0.0", в "Edit4" - "1", в "Edit5" - "254", в "Edit6" - "1". Все значения без кавычек. Жмем нашу кнопку начала сканирования. Все, проверка закончена.

P.S. Статья и программа предоставлена в целях обучения и вся ответственность за использование ложится на твои хилые плечи.




Реализовать фоновую работу программы

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


 ...
 public
   Row: integer;
   procedure OnIdleProc(Sender: TObject; var Done: Boolean);
 ...
 procedure TForm1.FormCreate(Sender: TObject);
 begin
   Application.OnIdle := OnIdleProc;
 end;
 
 procedure TForm1.OnIdleProc(Sender: TObject; var Done: Boolean);
 var
   i: integer;
   col: TColor;
   Gray: integer;
 begin
   for i := 0 to Form1.ClientWidth - 1 do
   begin
     col := Form1.Canvas.Pixels[i, Row];
     Gray := GetRValue(col) + round(30 * sin(i / 30 + Row / 50));
     Form1.Canvas.Pixels[i, Row] := RGB(Gray, Gray, Gray);
   end;
   inc(Row);
   if (Row = Form1.ClientHeight) then
     Row := 0;
   Done := false;
 end;
 
 procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
 var
   i: integer;
 begin
   with Form1.Canvas do
   begin
     Brush.Style := bsClear;
     for i := 0 to 1000 do
     begin
       Pen.Color := RGB(i, i, i);
       Rectangle(X - i, Y - i, X + i, Y + i);
     end;
   end;
 end;
 




Выполнение запросов к базе данных в фоне

Данный документ объясняет как выполнить запрос в фоновом режиме, используя класс TThread. Для получения общей информации о классе TThread, пожалуйста обратитесь к документации Borland и электронной справке. Для понимания данного документа вам необходимо иметь представление о том, как работать с компонентами для работы с базами данных, поставляемых в комплекте с Delphi 2.0.

Для осуществления потокового запроса необходимо выполнение двух требований. Во-первых, потоковый запрос должен находиться в своей собственной сессии с использованием отдельного компонента TSession. Следовательно, на вашей форме должен находиться компонент TSession, имя которого должно быть назначено свойству SessonName компонента TQuery, используемого для выполнения потокового запроса. Для каждого используемого в потоке компонента TQuery вы должны использовать отдельный компонент TSession. При использовании компонента TDataBase, для отдельного потокового запроса должен также использоваться отдельный TDataBase. Второе требование заключается в том, что компонент TQuery, используемый в потоке, не должен подключаться в контексте это потока к TDataSource. Это должно быть сделано в контексте первичного потока.

Приведенный ниже пример кода иллюстрирует описываемый процесс. Данный модуль демонстрирует форму, которая содержит по два экземпляра следующих компонентов: TSession, TDatabase, TQuery, TDataSource и TDBGrid. Данные компоненты имеют следующие значения свойств:

  Session1
 	Active	True;
 	SessionName	"Ses1"
 
   DataBase1
 	AliasName	"IBLOCAL"
 	DatabaseName	"DB1"
 	SessionName	"Ses1"
 
   Query1
 	DataBaseName	"DB1"
 	SessionName	"Ses1"
 	SQL.Strings	"Select * from employee"
 
   DataSource1
 	DataSet	""
 
   DBGrid1
 	DataSource	DataSource1
 
   Session2
 	Active	True;
 	SessionName	"Ses2"
 
   DataBase2
 	AliasName	"IBLOCAL"
 	DatabaseName	"DB2"
 	SessionName	"Ses2"
 
   Query2
 	DataBaseName	"DB2"
 	SessionName	"Ses2"
 	SQL.Strings	"Select * from customer"
 
   DataSource2
 	DataSet	""
 
   DBGrid1
 	DataSource	DataSource2

Обратите внимание на то, что свойство DataSet обоих компонентов TDataSource первоначально никуда не ссылается. Оно устанавливается во время выполнения приложения, и это проиллюстрировано в коде.


 unit Unit1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables;
 
 type
 
   TForm1 = class(TForm)
     Session1: TSession;
     Session2: TSession;
     Database1: TDatabase;
     Database2: TDatabase;
     Query1: TQuery;
     Query2: TQuery;
     DataSource1: TDataSource;
     DataSource2: TDataSource;
     DBGrid1: TDBGrid;
     DBGrid2: TDBGrid;
     GoBtn1: TButton;
     procedure GoBtn1Click(Sender: TObject);
   end;
 
   TQueryThread = class(TThread)
   private
     FSession: TSession;
     FDatabase: TDataBase;
     FQuery: TQuery;
     FDatasource: TDatasource;
     FQueryException: Exception;
     procedure ConnectDataSource;
     procedure ShowQryError;
   protected
     procedure Execute; override;
   public
     constructor Create(Session: TSession; DataBase:
       TDatabase; Query: TQuery; DataSource: TDataSource);
       virtual;
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 constructor TQueryThread.Create(Session: TSession; DataBase: TDatabase; Query:
   TQuery; Datasource: TDataSource);
 begin
   inherited Create(True); // Создаем поток c состоянием suspendend
   FSession := Session; // подключаем все privat-поля
   FDatabase := DataBase;
   FQuery := Query;
   FDataSource := Datasource;
   FreeOnTerminate := True;
     // Устанавливаем флаг освобождения потока после его завершения
   Resume; // Продолжение выполнения потока
 end;
 
 procedure TQueryThread.Execute;
 begin
   try
     { Выполняем запрос и подключаем источник данных к компоненту TQuery,
     вызывая ConnectDataSource из основного потока
     (для этой цели используем Synchronize)}
     FQuery.Open;
     Synchronize(ConnectDataSource);
   except
     { Ловим исключение (если оно происходит) и его дескриптор
     в контексте основного потока (для этой цели используем
     Synchronize). }
     FQueryException := ExceptObject as Exception;
     Synchronize(ShowQryError);
   end;
 end;
 
 procedure TQueryThread.ConnectDataSource;
 begin
   FDataSource.DataSet := FQuery; // Подключаем DataSource к TQuery
 end;
 
 procedure TQueryThread.ShowQryError;
 begin
   Application.ShowException(FQueryException); // Обрабатываем исключение
 end;
 
 procedure RunBackgroundQuery(Session: TSession; DataBase: TDataBase; Query:
   TQuery; DataSource: TDataSource);
 begin
   { Создаем экземпляр TThread с различными параметрами. }
   TQueryThread.Create(Session, Database, Query, DataSource);
 end;
 
 {$R *.DFM}
 
 procedure TForm1.GoBtn1Click(Sender: TObject);
 begin
   { Запускаем два отдельных запроса, каждый в своем потоке }
   RunBackgroundQuery(Session1, DataBase1, Query1, Datasource1);
   RunBackgroundQuery(Session2, DataBase2, Query2, Datasource2);
 end;
 
 end.
 

Метод TForm1.GoBtn1Click является обработчиком события нажатия кнопки. Данный обработчик события дважды вызывает процедуру RunBackgroundQuery, это случается при каждой передаче новых параметров компонентам для работы с базой данных. RunBackgroundQuery создает отдельный экземпляр класса TQueryThread, передает различные компоненты для работы с базой данных в его конструктор, который, в свою очередь, назначает их закрытым полям TQueryThread.

TQueryThread содержит две определенные пользователем процедуры: ConnectDataSource и ShowQryError. ConnectDataSource связывает FDataSource.DataSet с FQuery. Тем не менее, это делается в первичном потоке с помощью метода TThread.Synchronize. ShowQryError обрабатывает исключение в контексте первиного потока, также используя метод Synchronize. Конструктор Create и метод Execute снабжены подробными комментариями.




Процедуры кодирования и декодирования Base64


 function EncodeBase64(const inStr: string): string;
 
   function Encode_Byte(b: Byte): char;
   const
     Base64Code: string[64] =
       'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
   begin
     Result := Base64Code[(b and $3F)+1];
   end;
 
 var
   i: Integer;
 begin
   i := 1;
   Result := '';
   while i < =Length(InStr) do
   begin
     Result := Result + Encode_Byte(Byte(inStr[i]) shr 2);
     Result := Result + Encode_Byte((Byte(inStr[i]) shl 4) or (Byte(inStr[i+1]) shr 4));
     if i+1 < =Length(inStr) then
       Result := Result + Encode_Byte((Byte(inStr[i+1]) shl 2) or (Byte(inStr[i+2]) shr 6))
     else
       Result := Result + '=';
     if i+2 < =Length(inStr) then
       Result := Result + Encode_Byte(Byte(inStr[i+2]))
     else
       Result := Result + '=';
     Inc(i, 3);
   end;
 end;
 
 // Base64 decoding
 function DecodeBase64(const CinLine: string): string;
 const
   RESULT_ERROR = -2;
 var
   inLineIndex: Integer;
   c: Char;
   x: SmallInt;
   c4: Word;
   StoredC4: array[0..3] of SmallInt;
   InLineLength: Integer;
 begin
   Result := '';
   inLineIndex := 1;
   c4 := 0;
   InLineLength := Length(CinLine);
 
   while inLineIndex < =InLineLength do
   begin
     while (inLineIndex < =InLineLength) and (c4 < 4) do
     begin
       c := CinLine[inLineIndex];
       case c of
         '+'     : x := 62;
         '/'     : x := 63;
         '0'..'9': x := Ord(c) - (Ord('0')-52);
         '='     : x := -1;
         'A'..'Z': x := Ord(c) - Ord('A');
         'a'..'z': x := Ord(c) - (Ord('a')-26);
       else
         x := RESULT_ERROR;
       end;
       if x < > RESULT_ERROR then
       begin
         StoredC4[c4] := x;
         Inc(c4);
       end;
       Inc(inLineIndex);
     end;
 
     if c4 = 4 then
     begin
       c4 := 0;
       Result := Result + Char((StoredC4[0] shl 2) or (StoredC4[1] shr 4));
       if StoredC4[2] = -1 then Exit;
       Result := Result + Char((StoredC4[1] shl 4) or (StoredC4[2] shr 2));
       if StoredC4[3] = -1 then Exit;
       Result := Result + Char((StoredC4[2] shl 6) or (StoredC4[3]));
     end;
   end;
 end;
 




Связь BDE и Oracle

Автор: Neil Ferraiuolo

В SQL*Plus строка соединения - "xxxxxx.yyy"

В BDE это определяется как "@xxxxxx.yyy"

Символ @ является ключом.




BDE32 приложения в ptp-сети

Автор: Scott Frolich

Использование BDE32-приложений в Peer-To-Peer сети

Сетью Peer-To-Peer (сеть, где каждая машина действует как клиент и как сервер) может быть одна из следующих сетей, включая другие сетевые платформы, совместимые с ними:

  1. Windows 95
  2. Windows NT
  3. Lantastic
  4. Netware Lite
BDE автоматически обнаруживает таблицы на сетевом диске, но он не может их определить на dedicated сервере или server/client. Dedicated-сервера уведомляют приложение клиента о том, что файл был изменен или заблокирован. Данная функциональность отсутствует в Peer-To-Peer (не-dedicated) сетях. Для ее включения в сетях Peer-To-Peer, установите "LOCAL SHARE" в TRUE в BDE Configuration Utility на странице System. Это должно быть сделано на всех клиентах BDE, которые имеют доступ к таблицам в сетях, указанных выше. В случае файловых серверов Novell данное требование не является необходимым.

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

<Каталог общего доступа>
         |
         |--- <Каталог таблиц>
         |--- <Каталог Exe-файлов>
         |--- <Сетевой каталог>
Существуют две различных среды BDE, которые необходимо принимать во внимание:
  1. Использование только 32-битных приложений BDE.
  2. Использование только 32-битных приложений BDE совместно с 16-битными.
Установка только для 32-битных приложений

32-битное BDE полностью поддерживает соглашение об путях UNC вместе с длинными именами файлов. Рекомендуется использование соглашения UNC для всех сетевых соединений BDE. UNC позволяет обойтись без подключения (mapped) сетевых дисков. Это позволяет иметь доступ к таблицам и сетевым каталогам без необходимости заставлять пользователя подключать сетевые диски. UNC имеет следующий синтаксис:

  \<Имя сервера>\<Имя каталога общего доступа>\<Путь к каталогу>+<Имя файла>
Вот простой пример стандартного псевдонима (alias) BDE с использованием UNC:
Псевдоним: MyUNCAlias
         Тип: STANDARD
         Путь: \\FooServer\FooShare\Sharedir\Tables
         Драйвер по умолчанию: Paradox
Сетевой каталог может быть установлен и таким способом:
Драйвер: Paradox
         Сетевой каталог: \\FooServer\FooShare\Sharedir\NetDir
Сетевой каталог может быть установлен во время выполнения приложения с помощью session.netfiledir (Delphi) или DbiSetProp (C++ / Delphi)

Если по какой-либо причине UNC не может использоваться в 32-битных приложениях, следуйте за следующими инструкциями для среды с 32-битными и 16-битными приложениями BDE.

Установка для 16-битных и 32-битных приложений BDE

Поскольку 16-битное Windows API не поддерживает UNC, ее не поддерживает и 16-битное BDE. Для того, чтобы позволить приложениям иметь общий доступ к таблицам, все клиенты должны подключить один и тот же каталог на сервере. Если сервер также используется и в качестве клиента, то все другие клиенты должны подключить его корневой каталог диска. Логический диск при этом у клиентов может быть разным. Вот несколько примеров с работающими и неработающими настройками:

Клиент1:
     Путь: X:\Каталог общего доступа\Таблицы
 Клиент2:
     Путь: X:\Каталог общего доступа\Таблицы
   Работоспособно
 
 Клиент1: (Также машина с таблицами):
     Путь: X:\Каталог общего доступа\Таблицы
 Клиент2:
     Путь: X:\Каталог общего доступа\Таблицы
   Работоспособно
 
 Клиент1: (Также машина с таблицами):
     Путь: C:\Каталог общего доступа\Таблицы
 Клиент2:
     Путь: X:\Каталог общего доступа\Таблицы
 Клиент3:
     Путь: R:\Каталог общего доступа\Таблицы
   Работоспособно
 
 Клиент1:
     Путь: X:\Каталог общего доступа\Таблицы
 Клиент2:
     Путь: X:\Таблицы (Где "X:\Таблицы" реально -
 "X:\Каталог общего доступа\Таблицы", но имеющий
 общий доступ в "Каталог общего доступа")
   Неработоспособно. BDE должен иметь возможность
 иметь доступ к файлу Network Control (управление
 сетью).
Итог (установки для сетей Peer-To-Peer):

16- и/или 32-битные приложения:

  1. В BDE Configuration Utility установите "LOCAL SHARE" в TRUE.
  2. Не используйте UNC-имена.
  3. Не используйте таблицы с длинными именами файлов.
  4. Убедитесь в том, что все клиенты подключены к одному и тому же каталогу на сервере.
Только 32-битные приложения:
  1. В BDE Configuration Utility установите "LOCAL SHARE" в TRUE.
  2. Для получения доступа к сетевому каталогу и каталогу с таблицами используйте UNC-имена.
При невыполнении описанных выше шагов пользователи могут блокировать таблицы с получением следующей ошибки:
"Directory is controlled by other .NET file."
 (Каталог управляется другим .NET-файлом)
 "File:  PDOXUSRS.LCK" ("Файл:  PDOXUSRS.LCK")
 "Directory: " (Каталог: )
ИЛИ
 "Multiple .NET files in use."
 (Используются несколько .NET-файлов.)
 "File:  PDOXUSRS.LCK"
 (Файл:  PDOXUSRS.LCK)



Архитектура BDE и его особенности при работе с SQL-серверами 1

Кто такие бармаглоты? - Обожатели Borland'a.

Этот материал основан на изучении документации и справочных материалов по BDE и на собственном опыте. На самом деле информация из этого документа частично появлялась и раньше как в FAQ Borland так и в материалах других авторов (в частности Epsylon Technologies). Однако до сих пор большое количество разработчиков используют BDE. Но в последнее время все больше людей работают с SQL-серверами, и более популярными становятся компоненты прямого доступа - IBObjects/FreeIBComponents/IBExpress, Direct Oracle Access и другие. Кроме того, BDE не будет поддерживать Interbase 6.0 (диалект 3), да и вообще похоже, прекратит свое существование. В Delphi 6 наряду со старым BDE и в Kylix (Delphi и C++Builder для Linux) будет использоваться другая библиотека - dbExpress. Поэтому, чтобы поставить жирную точку (или крест, как хотите) на BDE, я и решил написать этот документ.

В большей степени этот текст напоминает то, что я читал на курсах по Delphi и разработке баз данных 3-4 года назад. Привет вам, курсанты! Можете прочитать этот документ хотя бы для того, чтобы освежить память.

Введение

Для начала вернемся лет на 10 назад. В те времена на компьютерах властвовали настольные СУБД - dBase, Paradox, FoxPro, Clipper и т.п. SQL-сервера в основном работали на мэйнфреймах. Среди форматов настольных СУБД был полный разнобой, и например, хотя Clipper, FoxPro и dBase работали с форматом DBF, использовать таблицы друг друга они фактически не могли из-за мелких, но существенных различий. Обмениваться данными в те времена между разными СУБД можно было разве что при помощи импорта-экспорта. Многие компании понимали, что так дальше продолжаться не может. Некоторые встраивали в свои продукты несколько "движков", но это приводило к распуханию продукта, да и чаще всего пользователи работали только с одним форматом данных, а не несколькими одновременно.

В 1990-м году Borland приобрел компанию Ashton-Tate, а вместе с ней и dBase (и Interbase). Таким образом у Borland появилось две настольные СУБД, с совершенно разными форматами - dBase и Paradox. Понятно, что для дальнейшего развития этих продуктов усилия по развитию форматов данных и работы с ними фактически удваивались. И в частности поэтому было принято решение создать некое универсальное ядро доступа к данным, которое могло бы работать с несколькими форматами данных единым образом. Созданию такого ядра также способствовало появление Windows, а следовательно и разделяемых библиотек - DLL. Можно было выпускать несколько продуктов, используя одни и те же dll доступа к данным. Это вполне соответствовало объектно-ориентированной концепции разработки ПО, которая не только использовалась в Turbo Pascal и в Turbo C++, но и при разработке собственных приложений Borland, таких как dBase, Paradox и Quattro (все для Windows).

примечание:

дальнейшая информация по датам взята из документа, подзаголовок "Evolution of BDE/IDAPI Technology: 1990 - 94".

Технология была названа Open Database Application Programming Interface - ODAPI, и впервые была использована в Quattro Pro 1.0 for Windows в сентябре 1992 года. В январе 1993-го эта же версия ODAPI 1.0 была использована в Paradox 1.0 for Windows, а затем и в dBase 1.0 for Windows. ODAPI пока поддерживал только форматы dBase и Paradox, и мог выполнять запросы к обоим форматам при помощи механизма Query By Example (QBE), пришедшего из Paradox for DOS.

справка:

драйверы ODBC 1.0 от Microsoft впервые появились в августе 1993 года. Информация из MSDN.

Всего через полгода, в сентябре 1993, ODAPI 1.1 уже поддерживала работу с SQL-серверами Interbase, Oracle, Sybase и Microsoft.

Версия 2.0 была переименована в IDAPI (слово Open было заменено на Integrated), и работами по расширению и стандартизации этого интерфейса уже занимался не только Borland, а целый комитет с IBM, Novell и Wordperfect включительно. В этой версии появился Local SQL - ядро для выполнения запросов SQL к локальным форматам данных, и IDAPtor - механизм для подключения ODBC-драйверов к IDAPI.

Последняя 16-ти разрядная версия IDAPI 2.5 использовалась в Delphi 1. Далее, начиная с 3.0 (12 января 1996 года в составе Paradox 5.0 for Windows), пошли 32-разрядные версии. Собственно, на этом развитие функциональности BDE закончилось. Добавлялись новые драйверы для доступа к SQL-серверам DB2, Informix, в BDE 3.5 появились кэшированные обновления (CachedUpdates), появился драйвер FoxPro и сопряжение с DAO, но все это происходило на протяжении достаточно длительного срока - с 1996 по 2000.

С одной стороны, функциональность BDE можно назвать даже избыточной. С другой стороны повлияла конкуренция со стороны Microsoft, стандарта ODBC. Собственно, по функциональности ODBC является подмножеством BDE, но Microsoft в те годы предпринимала очень активные действия по продвижению ODBC, и главным в этом был выпуск ODBC SDK, с помощью которого любая фирма могла разработать собственный ODBC-драйвер (надо сказать, что в те годы их было огромное количество, причем большинство было весьма низкого качества и невысокой производительности). А BDE был более "закрытым". Например, BDE SDK так и не увидел свет, и был доступен разве что избранным (я оказался в их числе, и надо сказать, что качество BDE SDK и удобство написания драйверов было на высоте). С третьей стороны, к этому времени WordPerfect был куплен Novell, Paradox также был продан Novell, а затем Corel, а IBM похоже просто потеряла к IDAPI интерес.

Короче, комитет IDAPI распался, а Microsoft задавил конкуренцией.

Несмотря на перечисленные негативные моменты, BDE активно использовался не только самим Borland, но и многими другими фирмами. Это Novell (продукт InForms), ReportSmith (впоследствии купленный и проданный Borland), CrystalReports (вплоть до версии 5.0 использовал BDE) и так далее.

Архитектура

Увлекшись историей я немного пропустил, зачем все это (BDE) делалось. Частичная цель упоминалась выше - предоставить универсальное ядро доступа к локальным форматам данных. Основная - обеспечить прозрачную работу приложений как с локальными форматами, так и с SQL-серверами. Как сейчас помню, что именно удобство при работе с SQL-серверами рекламировалось как основное. Однако в последние 2-3 года именно эта возможность вызывала наибольшее количество нареканий. Давайте рассмотрим архитектуру BDE.

Основная работа с BDE производится посредством внешнего интерфейса IDAPI (IDAPI32.DLL). Формат данных выбирается в псевдониме (alias) соединения, и в принципе дальше работа с разными форматами ничем не отличается. В том числе и неважно, как работает приложение с BDE - через компоненты VCL DB, которые используют функции BDE, или напрямую (все равно компоненты используют те же функции BDE).

Дальше функции IDAPI транслируют вызовы в функции соответствующего драйвера. Если это драйвер локального формата (dBase, Paradox, FoxPro), то драйвер формата сам работает с соответствующими файлами (таблицами и индексами). Если это SQL Link, то вызовы транслируются в вызовы функций API клиентской части конкретного SQL-сервера. Для каждого сервера SQL Link свой.

IDAPTOR (соединитель с ODBC) и интерфейс к DAO работает точно также как и SQL Link, т.е. просто транслирует вызовы BDE в вызовы ODBC или DAO, непосредственно к формату не имея никакого отношения.

Если посмотреть на файлы BDE, то можно подробно рассмотреть его составные части.

IDAPI32.DLL
Основной интерфейс
BLW32.DLL, BANTAM.DLL
Языковые функции
*.BTL
Файлы с языковыми кодировками.
IDBAT32.DLL
Операции пакетного копирования данных
IDDR32.DLL
Модуль работы с Data Repository
IDASCI32.DLL
Драйвер для работы с текстовым форматом
IDDAO32.DLL
Драйвер трансляции вызовов к DAO
IDODBC32.DLL
Драйвер трансляции вызовов к ODBC
IDPDX32.DLL
Драйвер для работы с форматом Paradox
IDDBAS32.DLL
Драйвер для работы с форматом dBase и FoxPro
IDQBE32.DLL
Ядро обработки запросов QBE
IDSQL32.DLL
Ядро обработки запросов SQL
SQLINT32.DLL
SQLLink-драйвер трансляции вызовов к Interbase API
SQLORA32.DLL
SQLLink-драйвер трансляции вызовов к Oracle Call Level Interface
SQL*32.DLL
Другие SQLLink-драйверы

Таким образом, при установке BDE "лишние" файлы можно без проблем выкинуть.

Также, надеюсь, понятно, почему BDE "не работает" с SQL-сервером, если не установлена клиентская часть этого сервера (то же самое по отношению к DAO - без дистрибутива DAO BDE не будет работать с файлами MS Access). Вообще клиентские части SQL-серверов несовместимы между собой абсолютно. Поэтому невозможно написать универсальный SQL Link.

Данный рисунок и список файлов, возможно, развеет популярный миф о том, что Delphi хорошо приспособлена для работы с Interbase. Как видите, Interbase для Delphi столь же равноправен, как скажем, Oracle или любой ODBC-драйвер. В отличие от продуктов Microsoft в BDE нет никаких "обходных" функций для работы со своими форматами, т.е. работа с IB ведется только через SQL Link (без sqlint32.dll BDE вообще не знает, что такое Interbase).

Отдельное место в архитектуре BDE и среди упомянутых файлов занимают Local SQL и QBE Engine. Эти механизмы запросов будут рассмотрены чуть дальше.

TTable и TQuery

TTable и TQuery являются основными компонентами, используемыми при программировании приложений баз данных (TStoredProc не в счет, и без него можно прекрасно обойтись, вызывая процедуры через select или execute в компоненте TQuery). TTable предоставляет доступ как к таблицам, а TQuery позволяет выполнять произвольные запросы. Если с TQuery все понятно - он выполняет тот запрос, который написан в свойстве TQuery.SQL - то TTable скрывает очень много подробностей своей работы от программиста. Без SQL Monitor увидеть все тонкости невозможно (если кто не знает - SQL Monitor находится в меню Database).

Итак, запустите Delphi, откройте SQL Monitor, положите на форму компонент TDatabase, подсоединитесь к серверу, затем положите компонент TTable, присоедините его к алиасу TDatabase и выберите любую таблицу из списка (свойство TableName). Переключитесь на SQL Monitor, сотрите все что там появилось, переключитесь обратно, и включите TTable.Active:=True; Смотрим в SQL Monitor (лог с самого начала):

  • первым запросом BDE хочет убедиться, что выбранная нами таблица существует.
  • второй запрос выбирает список полей выбранной таблицы, их названий, типов, условий проверки и т.п.
  • третий запрос выбирает информацию об индексах указанной таблицы. Определяется, есть ли среди них первичный ключ, и по каким полям построены индексы.
  • четвертый запрос почти повторяет второй, и выбирает информацию о полях - условия проверки, "вычисляемость" поля, допустимость NULL и прочее.
  • собственно, пятый запрос открывает таблицу, формируя запрос SELECT FIELD1, FIELD2, ... FROM TABLE ORDER BY PK_FIELD ASC.

Заметьте, что подобные запросы выполняются каждый раз при открытии таблицы (любой) компонентом TTable. Перечитывания этих данных можно избежать, если включить у используемого алиаса параметр ENABLE SCHEMA CACHE. При этом считанную первый раз информацию BDE размещает на диске в указанном каталоге (SCHEMA CACHE DIR) в специальном файле, кэширует информацию для SCHEMA CACHE SIZE количества таблиц, и держит эту информацию в кэше в течение SCHEMA CACHE TIME секунд (если -1, то вечно). Если структуры таблиц закэшированы, то при их изменении на сервере (например, добавили новое поле) приложение будет работать со старой структурой, что может вызвать серьезные проблемы в работе приложения. SCHEMA CACHE нужно использовать только тогда, когда структура базы данных определена окончательно и не изменяется. Если все же очень сильно хочется использовать кэширование структур таблиц, то не забывайте правильно установить параметр SCHEMA CACHE TIME. Или при первом за день подключении приложения к серверу сначала кэширование структур можно выключить, отсоединиться, включить и подсоединиться снова - таким образом в самом начале работы кэш структур таблиц будет создан, и будет использоваться в течение дня.

примечание:

параметры SCHEMA CACHE не имеют абсолютно никакого отношения к механизму Cached Updates или к кэшированию данных.

Вернемся к запросу, которым TTable открыл таблицу. В конце запроса стоит указание порядка сортирвки - ORDER BY FIELD ASC. По умолчанию TTable сортирует данные в порядке поля первичного ключа. И кстати, если пользоваться свойством TTable.IndexName, то все равно к запросу будет добавляться ORDER BY INDEXFIELD ASC. Таким образом получается, что свойство IndexName при работе с SQL-серверами бессмыслено. Вместо него нужно просто использовать свойство IndexFieldNames. Даже если в этом свойстве указать поле, по которому нет индекса, то все равно BDE "прицепит" к запросу ORDER BY FIELD ASC. Кстати, BDE абсолютно игнорирует направление индекса, и всегда в запросе добавляет ASC, даже если индекс по этому полю создан как DESCENDING (по убыванию). Получается, что отсортировать таблицу в TTable по убыванию нельзя.

примечание:

можно было бы отнести этот недостаток на SQL Link для IB, но вполне возможно что просто TTable не в состоянии кэшировать и обновлять данные, отсортированные по убыванию (см. дальше о кэше данных).

Кэширование данных

Как видно из предыдущего раздела, TTable работает с таблицами сервера не каким-то хитрым образом, а формируя самые нормальные SQL-запросы. И тут начинается самое интересное. Оказывается, при выполнении запроса сервер выдает записи клиенту (приложению) по очереди и по одной записи. Причем только "сверху вниз". Как только записи на сервере кончились, сервер сообщает клиенту об этом сигналом EOF вместо выдачи очередной записи. Конечно, в некоторых современных серверах есть произвольное позиционирование и проход по выборке не только сверху вниз но и в обратном порядке, но это требует от сервера достаточно больших ресурсов.

примечание:

разумеется, клиентская часть SQL-сервера может принимать записи от сервера "пачками". Но в любом случае получение записи инициируется только вызовом функции fetch, и по этой команде "выбирается" только одна запись. Т.е. приложение получает записи по одной независимо от того, буферизируются они на сервере/клиенте или нет.

Поскольку BDE - вещь универсальная, то он должен обеспечить возможность перемещения по записям вверх и вниз независимо от сервера. Т.е. он должен обеспечивать кэширование записей самостоятельно. Взял запись с сервера - положил в кэш. Это означает, что если вы открыли таблицу в 100 тысяч записей, и нажали в гриде Ctrl-End, то все 100 тысяч записей "приедут" к вам на клиентский компьютер. С таким пожиранием ресурсов надо как то бороться. Если в TQuery можно ограничить количество выбираемых записей условиями запроса, то в TTable этого сделать нельзя, поскольку как мы уже видели, TTable формирует запросы самостоятельно.

Живой и мертвый кэш, или TTable и TQuery

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

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

"Мертвый" кэш существует до тех пор, пока запрос не будет закрыт (TQuery.Close).

Живой кэш более сложен, и для его понимания придется использовать чуть больше компонент на уже открытой в Delphi форме. Добавьте к TDatabase и TTable компоненты TDataSource и TDBGrid. Grid растяните по вертикали так, чтобы в нем было видно штук 5 записей (7, или 9, не больше). Желательно чтобы в таблице при этом было не меньше 20-30 записей. Поместите кнопку рядом с Grid-ом, в которой на OnClick напишите


 Table1.IndexFieldNames := 'FIELD';
 

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

Скомпилируйте приложение, запустите его (не забыв запустить SQL Monitor). Поместите курсор грида посередине, как показано на рисунке (на содержимое грида не обращайте внимания - у вас оно будет совершенно другим, в зависимости от выбранной таблицы).

Сотрите все в SQL Monitor. И нажмите кнопку Button1. Теперь возвращаемся к началу лога в SQL Monitor:

  • первый запрос выбирает значение поля, по которому нужно отсортировать данные.
  • второй запрос выбирает данные от текущей записи и "выше" - см добавку WHERE FIELD < ? ORDER BY FIELD DESC
  • третий запрос выбирает запись, которую нужно поместить на место текущей (выборка запомненного первым запросом значения). Кстати, этот запрос у меня почему-то выполнился аж три раза (BDE 5.1.1). Раньше он обычно выполнялся всего один раз.
  • четвертый запрос выбирает данные от текущей записи и ниже - см. добавку WHERE FIELD > ? ORDER BY FIELD ASC

Вот это и есть "живой" кэш. Т.е. при любых операциях перемещения по набору данных, отличных от перемещения на одну запись (или PageUp/PageDown) вверх или вниз, TTable уничтожает текущий кэш, перечитывает данные столь экзотическим образом, и создает новую копию кэша. По количеству вызовов isc_dsql_fetch вы можете понять, что как "вверх" так и "вниз" от текущей записи второй и четвертый запросы выбрали ровно столько записей, сколько помещается в Grid. Если вы продолжите движение курсором по одной строке вверх или вниз, то увидите каким способом (зачастую неэффективным) BDE довыбирает необходимые записи (особенно неэффективность проявляется при движении вверх).

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

Существенный момент - выборка "вверх" всегда использует сортировку по убыванию. Если по полю сортировки нет индекса по убыванию, то Interbase (или другой сервер) будет сортировать результат в памяти или на диске, что существенно медленнее сортировки с использованием индекса. Поэтому "резкие" перемещения, например в конец таблицы при помощи Ctrl-End будут приводить к значительной паузе, пока сервер отсортирует данные и выдаст резульат. Повысить скорость в этом случае можно только использованием ClientDataSet, который сортирует кэш вместо выдачи серверу SQL-запросов.

Locate в живом кэше в отличие от мертвого кэша выполняется намного быстрее, т.к. TTable применяет ту же самую технику очистки кэша для поиска нужной записи.




Архитектура BDE и его особенности при работе с SQL-серверами 2

Фильтрация

Фильтрация TTable и TQuery происходит с учетом живого или мертвого кэша. Для TTable при наложении фильтра конструируется соответствующий SQL-запрос, а TQuery производит фильтрацию буквально при помощи Locate (т.е. сначала выбираются все записи в кэш, а затем идет фильтрация уже в кэше).

О вреде UNIQUE constraint

В Interbase уникальность поля можно обеспечить тремя способами: создать первичный ключ, создать unique constraint, и создать уникальный индекс. Но при чем здесь Interbase? А при том, что BDE открывает TTable по умолчанию с использованием уникального индекса. Если таблица одновременно содержит как первичный ключ, так и unique constraint, то в результате у таблицы 2 уникальных индекса. При обращении к списку индексов TTable берет для сортировки по умолчанию первый попавшийся. Если уникальность поля обеспечивается обычным уникальным индексом, то проблем нет. А вот если та же уникальность обеспечивается через UNIQUE constraint, то при backup/restore базы данных есть шанс что порядковые номера индексов поменяются (поскольку для IB это constraint целостности), и BDE будет брать в качестве первого попавшегося индекс от unique constraint вместо индекса от primary key. Вреда от этого, в общем, никакого нет, но в результате это вызывает нежелательный порядок сортировки по умолчанию в приложениях.

"Живые" запросы

Если способность TTable редактировать и удалять записи ни у кого не вызывает удивления, то TQuery требует, чтобы свойство RequestLive было установлено в True. Если при False запрос отправлялся непосредственно на сервер, то при True запрос предварительно обрабатывается локальным SQL (модуль IDSQL32.DLL). Это необходимо для того, чтобы TQuery смог сформировать запросы INSERT/UPDATE/DELETE на основании заданного SELECT. Для TTable построение таких запросов не представляет сложности, т.к. задано только имя таблицы, имена полей считаны и т.п. А существующий SQL-запрос нужно синтаксически разобрать, чтобы понять, сколько в нем используется таблиц, какие выбираются поля и из каких таблиц, и можно ли вообще сформировать запросы на вставку, обновление и удаление данных.

Именно таким разбором SQL и занимается Local SQL. Разумеется, он поддерживает весьма ограниченный синтаксис SQL, что не позволяет делать "живыми" запросы, использующие расширенные конструкции SQL, пользовательские функции или специфические для конкретного сервера особенности. Например, для организации живого запроса вместо


 SELECT * FROM TABLE
 WHERE FIELD STARTING WITH 'A'
 

придется писать


 SELECT * FROM TABLE
 WHERE FIELD LIKE 'A%'
 

Подобную замену еще можно пережить, но не всегда возможно найти замену конструкции, которую не понимает Local SQL, и прекрасно понимает сервер.

примечание:

вы сами можете убедиться в изложенном, поместив первый запрос в TQuery, переключив RequestLive в True. Попытайтесь установить Active компонента в True и посмотрите что получится.

Собственно, как вы поняли, на самом деле никаких "живых" запросов не существует. В SQL оператор SELECT выполняет только чтение, а вставить, обновить или удалить записи можно только операторами INSERT, UPDATE и DELETE, и никак иначе.

При переключении TQuery.RequestLive:=True TQuery начинает вести себя как TTable - т.е. он сначала разбирает запрос, извлекает оттуда имя таблицы, и потом выбирает информацию из системных таблиц о полях таблицы, индексах и т.п. Вы можете все это увидеть в SQL Monitor.

Кроме RequestLive можно еще воспользоваться и компонентом UpdateSQL. Об этом см. дальше в разделе CachedUpdates.

SQLQUERYMODE

Кроме RequestLive на выполнение запросов влияет и параметр алиаса или драйвера IB SQLQUERYMODE. Когда этот параметр установлен в LOCAL, BDE всегда производит разбор SQL-конструкций при помощи Local SQL. Если параметр установлен в "пусто", то BDE сначала пытается отправить SQL на сервер, а при получении ошибки пытается выполнить его Local SQL. При установленном параметре SERVER запросы всегда отправляются только на сервер (за исключением "живых").

Таким образом, при установке LOCAL запросы будут всегда выполняться локальным ядром SQL BDE, и функциональность SQL IB будет недоступна (не будут выполняться запросы с containing и др. синтаксисом, который не поддерживает Local SQL). Избавиться от такого поведения лучше всего установив раз и навсегда значение SERVER.

Refresh и атомарность запросов

Читатель уже после информации о живом и мертвом кэше, наверное, давно хочет спросить - а как же BDE видит новые записи, добавляемые другими приложениями? Да никак. С TTable все понятно - в любой момент можно вызвать refrech, что приведет к удалению "живого" кэша и переоткрытию TTable как мы уже видели в разделе о кэшах записей. TTable перед своим закрытием запоминает запись, на которой стоял курсор грида, и поэтому после открытия может спозиционироваться на эту же запись.

TQuery работает с "мертвым" кэшем, поэтому обновлять его невозможно. BDE не знает о том, какое из полей в запросе является первичным ключом, да и вообще по скольким таблицам построен запрос. Поэтому единственным вариантом для refresh является переоткрытие TQuery (Close/Open). Текущая запись при этом будет потеряна. Можно, правда, попытаться использовать TBookmark чтобы запомнить запись и вернуться к ней после открытия TQuery, но как и Locate это вызовет выборку всех записей с сервера в кэш TQuery и при большом количестве выбираемых записей может занять длительное время.

примечание:

Даже если компонент IBX IBTable и поддерживает Refresh, то он его выполняют точно таким же образом, что и BDE. А компонент IBDataSet выполняет Refresh только для одной, текущей, записи.

В чтение актуальных данных вмешивается еще и атомарность операторов SQL. Применительно к SELECT это означает, что он будет выбирать только те записи, которые существовали на момент выполнения этого SELECT. Это означает, что если открыть TQuery, а затем через 5 минут подсоединить его к гриду, то в нем будут видны только те записи, которые были в базе данных 5 минут назад. Даже если за это время это же самое приложение в этой же транзакции успело добавить, изменить или удалить 1 или сколь угодно большее количество записей, попадающих под условия выборки данного SELECT.

В буквальном смысле это означает, что если вставить запись в открытый select, то увидеть новую запись нельзя. Для этого придется переоткрыть запрос. По отношению к TQuery это справедливо, а вот TTable "обманывает" пользователя, помещая данные успешно вставленной записи прямо в свой собственный кэш. Таким образом, вставка в TTable как бы помещает данные прямо в открытую выборку. Чего, собственно, на самом деле на сервере не происходит.

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

примечание:

в отличие от атомарного SELECT, оператор FOR SELECT внутри процедур IB не является атомарным. Т.е. если в цикле FOR SELECT добавлять записи, то они могут попасть в область видимости FOR SELECT, и может произойти "бесконечный цикл". Также в IB неатомарной является конструкция INSERT INTO ... SELECT FROM.

Завершение транзакций

BDE устроен так, что компонент TDatabase может работать только с одной транзакцией одновременно. При этом может быть два режима - неявная работа с транзакциями (AUTOCOMMIT, NOAUTOCOMMIT), и явная работа с транзакциями (методы StartTransaction, Commit и Rollback). В режиме AUTOCOMMIT BDE самостоятельно завершает транзакцию и стартует новую при любых модификациях данных (insert/update/delete) или при вызове TStoredProc.ExecProc. Таким образом изменения автоматически сохраняются в базе данных. Однако чтение данных и вообще работа с ними может быть выполнена только в контексте транзакции. Т.е. вне транзакции с данными работать нельзя, т.к. не будет обеспечиваться целостность данных. При этом данные, прочитанные в одной транзакции, неактуальны для другой транзакции. Если посмотреть справку BDE32.HLP по функции dbiEndTran, то можно обнаружить, что BDE при завершении явной или неявной транзакции ведет себя следующим образом:

открытый query довыбирает данные.

открытый table закрывается

другие случаи я не упомянул, потому что IB SQL Link их не поддерживает. То есть при любом завершении транзакции (и открытии новой) данные будут перечитываться. Для TTable это не смертельно, т.к. он знает первичный ключ записи, на которой стоял курсор грида, и может перечитать немного данных, чтобы заново отобразить их. А вот для TQuery, который не знает никаких первичных ключей, происходит полная выборка всех данных, что эквивалентно вызову Locate, FetchAll или Last. Так что если ваше приложение при обновлении данных почему-то сильно тормозит, или возникают паузы, то нужно срочно смотреть в SQL Monitor, какие именно запросы перечитываются.

примечание:

иногда по неизвестным причинам BDE перечитывает запросы, которые совершенно этого не требуют. Например мне встречалась ситуация с неявным перевыполнением запроса при перемещении по grid-у detail-таблицы, причем запрос никак не был связан ни с master ни с detail-таблицами. Избавиться от проблемы не удалось.

Соответственно, чтобы предотвратить плохую производительность, нужно или держать минимум данных открытыми в TQuery, или стремиться к минимизации количества записей, выбираемых TQuery. Также можно открыть второй TDatabase, и работать например со справочными таблицами только в нем. Таким образом изменения будут идти в одном коннекте, и не будут вызывать завершение транзакции и перечитывание данных в другом. В компонентах прямого доступа это решается более простым способом, т.к. там поддерживается произвольное количество транзакций для одного коннекта. Есть, кстати, и оригинальное решение, которое позволяет использовать коннект TDatabase совместно с компонентами FreeIBComponents или IBX:


 var
   h: tisc_db_handle;
 
 DB := TIBDatabase.Create(nil);
 
 try
   Dbtables.Check(DbiGetProp(HDBIOBJ(DMCommBilling.Database.Handle), dbNATIVEHNDL, @h, sizeof(tisc_db_handle), l));
   DB.DBName := 'Cloned';
   DB.Handle := h;
   TR := TIBTransaction.Create(nil);
 
 try
 

и так далее. Таким образом, в приложении BDE можно дополнительно обрабатывать данные в транзакциях IBX. Приложение получается комбинированным, поскольку для доступа к данным в новой транзакции придется использовать компоненты IBX.

Record/Key deleted

Надо сказать, что BDE облегчает жизнь программисту хотя бы тем, что перечитывает запись, которую собирается редактировать пользователь. Т.е. как только BDE переводит TTable или "живой" TQuery в режим Edit, он производит выборку текущей записи (по первичному ключу) и показывает для редактирования самые последние, актуальные, данные. Правда, пока пользователь редактирует запись, ее могут изменить или даже удалить другие пользователи - BDE никоим образом не "блокирует" запись, которая редактируется, т.к. в SQL вообще нет команды вроде "заблокировать запись". Поэтому после Post клиент может обнаружить, что его изменения не попадут в базу данных, т.к. запись уже изменилась или удалена. И обнаружит он это или нет, зависит от режима TDataSet.UpdateMode.

UpdateMode имеет 3 режима:

upWhereAll
По умолчанию - BDE пытается сделать UPDATE с внесением в условие WHERE всех значений полей, которые были ДО момента редактирования. Если при этом произошла ошибка, значит хотя бы одно поле у редактируемой записи уже было кем-то изменено (с момента входа в режим редактирования до момента Post).
upWhereChanged
BDE пытается сделать UPDATE с условием WHERE, проверяющим старые значения только измененных полей. Т.е. чтобы убедиться, что пользователь поменял именно те значения полей, которые видел, на новые. Если произошла ошибка, то это значит что одно из изменяемых полей было уже кем-то изменено.
upWhereKeyOnly
BDE обновляет запись, устанавливая в WHERE поиск записи только по ее первичному ключу.

Соответственно, если запись не найдена, то выдается упомянутое в заголовке сообщение Record/Key deleted. Обратите внимание, что успешное обновление записи в режимах upWhereChanged или upWhereKeyOnly может вызвать проблемы с конкурентным обновлением. Например, существует таблица TABLE, у которой три поля: ID, NAME и PRICE.

Два пользователя открывают таблицу. Один видит, что для данного имени товара неверно указана цена. Другой счел, что цена правильная, только имя товара указано с ошибкой. У обоих UpdateMode установлен в upWhereKeyOnly или upWhereChanged.

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

В данном частном случае избавиться от проблемы можно установкой UpdateMode только upWhereAll, чтобы запрос при обновлении проверял все зависимые поля. Или, можно подключить компонент TUpdateSQL и прописать для обновления данных запрос, который будет проверять на "старые" значения и имя товара и его цену. Однако работать с TUpdateSQL без CachedUpdates невозможно.

Другая причина, по которой может происходить сообщение Record/Key deleted - перечитывание данных после их обновления. BDE таким образом (по крайней мере для TTable) пытается вставить запись в нужное место (в порядке сортировки) кэша. Но если после вставки или обновления запись на сервере изменилась - другим пользователем, default-условием или триггером (с генератором) - то BDE не сможет ее найти и выдаст упомянутое сообщение.

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

Cached Updates

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

CachedUpdates позволяет накопить изменения, и затем "выстрелить" их на сервер одним пакетом. При этом время блокировок минимально, минимален также сетевой трафик, но существует высокая вероятность что данные уже успели измениться. Поэтому при использовании CU необходимо тщательно планировать именно процесс обращения к таблицам и режимы UpdateMode.

За более подробной информацией по CachedUpdates обращайтесь к документации или к книге Шумакова ("Delphi 3 и создание приложений баз данных", в том числе последующие издания для Delphi 4 и 5 в соавторстве с Фароновым), где все это очень хорошо описано. Нас сейчас CU больше интересует как замена RequestLive.

Действительно, "оживление" запроса выполняется следующим образом - к компоненту TQuery подключается компонент TUpdateSQL, в котором прописываются вручную или автоматически запросы на вставку, удаление или изменение записи. Заметьте, только одной записи. После включения CachedUpdates:=True при модификации данных именно эти запросы, а не конструируемые Local SQL при RequestLive=True, будут отправляться на сервер (отправляются они только в момент ApplyUpdates, а не в момент реального обновления записи).

Самым непонятным является то, почему связка TQuery и TUpdateSQL не может работать без CachedUpdates. Например компоненты IBX без проблем обеспечивают такой режим, да и вообще там у TIBQuery нет свойства RequestLive (т.к. нет парсера SQL на клиентской стороне). Т.е. в IBX, конечно, можно использовать CachedUpdates, но разве что при действительной в нем необходимости.

Гетерогенные запросы

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

Выполнить гетерогенный запрос можно следующим образом:

  1. Открыть 2 или более TDatabase, каждый для соответствующей базы данных. Например, один компонент подсоединен как A к алиасу TEST, а другой, как
  2. Открыть TDatabase, который подсоединен к драйверу типа STANDARD(т.е. к локальным таблицам. Существование оных необязательно). См. окно свойств TDatabase.
  3. Выполнить запрос в компоненте TQuery, подсоединенном к "стандартному" TDatabase. В результате должна получиться такая "конструкция"

а запрос иметь вид


 SELECT C.CLIENT_NAME
 FROM ":A:CLIENTS" C, ":B:EMPLOYEE" E
 WHERE E.EMP_NO = C.CLIENT_ID
 

Конечно, по смыслу это полная чушь, но зато показывает пример указания таблиц из разных базах данных. Еще один пример запроса можно найти по ключевой фразе 'heterogeneous joins' в BDE32.HLP.

Пока я готовил и проверял этот пример, установка Query1.Active в true вызывала страшные содрогания винчестера. Дело в том, что подобные запросы выполняются следующим образом:

  1. Ядро Local SQL "разбирает" запрос, и выясняет, какие таблицы из каких баз данных используются в запросе
  2. Данные из каждой таблицы вытаскиваются в локальный кэш (т.е. на клиента), в память или временные таблицы.
  3. Извлеченные данные обрабатываются локальным SQL (join, where, order by и т.п.).

Однако происходит так не всегда. По крайней мере в моем тестовом случае Local SQL начал выполнять просто чудовищные операции:

Сначала для одной, а затем для другой таблицы был выполнен SELECT COUNT(*). Т.е. Local SQL сначала пытается понять, во что ему обойдется скачивание данных на клиентскую часть. Очевидно, записей в CLIENTS ему показалось мало, и он вытащил все записи из EMPLOYEE, а потом начал последовательно выбирать соответствующие записи из CLIENTS отдельными запросами для каждой записи (проверяя соответствие условия WHERE). Буквально SELECT ... FROM CLIENTS WHERE CLIENT_ID = ? ORDER BY CLIENT_ID ASC.

(зачем здесь нужен order by - неизвестно). Почему произошло не наоборот, т.е. меньшая таблица не была выбрана в память, неясно.

Можно даже не упоминать, что select count(*) на реальных данных может выполняться долго (даже без учета возможной сборки мусора). Не говоря о том, что в EMPLOYEE было 42 записи, и отдельных запросов к таблице CLIENTS получилось тоже 42.

Вот такая веселая арифметика. Зато получены четкие объяснения, почему "трещал" винчестер.

Однако, пусть даже и таким жутким способом, но BDE умеет выполнять гетерогенные запросы. Благодаря Local SQL и тому, что BDE умеет работать с локальными таблицами (которые он использует для хранения промежуточных данных таких запросов). Ни IBObjects, ни FIBC/IBX, ни IB API не имеют таких возможностей, и соответственно, не могут выполнять гетерогенные запросы.

Итог

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

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

Кстати, может оказаться, что вся эта "неэффективность" в смысле большого объема передаваемых данных на вашей 100мбит сети и не проявится. А если сеть гигабитная, то вы вообще никакого лишнего трафика не заметите. И наоборот - для модемных соединений BDE, конечно, никуда не годится. Или если вам нужно тщательное планирование и управление транзакциями IB, то BDE здесь тоже делать нечего.

Есть и более жесткие критерии выбора - если вы собираетесь переходить на Kylix или IB6 (диалект 3), то c BDE придется расстаться. Если же в течение ближайшего года или полутора вы не собираетесь этого делать - забудьте об альтернативах, и продолжайте работать привычным способом.




Протокол блокировки BDE

Тема: BDE и Database Desktop Locking Protocol

Предполагаемая аудитория
Данная информация будет полезна каждому, кто решил разрабатывать приложения для работы с базами данных с использованием Delphi и BDE.

Предварительные условия
Базовые знания или интерес к протоколам блокировки Paradox и форматам таблиц.

Цель
Дать пользователям лучшее понимание протокола блокировки таблицы.

Таблицы, типы полей и поддерживаемые характеристики
Каждый следующий выпуск Paradox, начиная с версии 2.0, содержал улучшения структуры таблицы. Все типы таблиц Paradox, начиная с Paradox 1.0 и заканчивая Paradox 3.5, совместимые друг с другом.

Paradox 4.0 добавляет новый тип данных к формату таблиц: Binary Large Objects (бинарные большие объекты), обычно известные как BLOb'ы, и новые типы вторичных индексов. Paradox 4.0 поддерживает два типа BLOb-полей: Memo и BLOb. Paradox старее версии 4.0 и Engine до версии 3.0 не могут читать, писать и создавать этот новый табличный формат. При попытке чтения или записи таблиц типа Paradox 4.0 более ранней версией Paradox, вы получите ошибку о защите таблицы паролем.

Paradox 5.0 добавляет несколько новых типов данных к формату таблиц: Long Integer, Time, TimeStamp, Logical, Autoincrement, BCD, Bytes. Paradox 7.0 добавляет наследуемый вторичный индекс. Создание или любое изменение таблицы переводит ее формат на новый уровень, включающий все вышеописанные характеристики. По умолчанию создаваемая с использованием Database Desktop или BDE (Borland Database Engine) таблица имеет тип Paradox 4.0. Данный тип, заданный по умолчанию, может быть изменен с помощью утилиты BDE configuration utility или Database desktop configuration utility, и ему может быть присвоен тип Paradox 3, 4, 5 или 7 для BDE.

Paradox 4.0 может читать, писать и создавать таблицы типа Paradox, совместимые с таблицами версий от Paradox 1.0 до Paradox 4.0. Так, таблица, созданая в Paradox 1.0, совместима с Paradox 4.0. Таблица, созданная в Engine 1.0 или 2.0, может быть прочитана и записана в Paradox 4.0.

Paradox и Engine не изменяет тип таблицы при чтении или записи. Тип таблицы изменяется только при ее реструктуризации.

Протоколы блокировки Paradox
Есть два различных протокола блокировки Paradox: протокол, введенный в Paradox 2.0 и протокол, введенный в Paradox 4.0. Эти два протокола не совместимы друг с другом. Протокол блокировки не оказывает влияния на тип таблицы, с которым может работать программа. Существуют несколько программ, также поддерживающих протоколы блокировки; тем не менее, эти программы в отдельный момент времени могут поддерживать только один протокол. Здесь мы рассматриваем только протокол блокировки версии 4.0.

Протокол блокировки Database Desktop/ Paradox 4.0
Протокол блокировки Paradox 4.0 - единственный протокол, доступный для Paradox 4.0 и IDAPI Engine. Обозначение "Paradox 4.0 locking protocol" представляет данный стиль блокировки.

Блокировки каталога
Paradox 4.0 располагает файл блокировки, PDOXUSRS.LCK, в каждом каталоге, в котором доступны таблицы. Файл блокировки регулирует доступ к файлам, расположенным в каталоге. Файл блокировки ссылается на PDOXUSRS.NET, поэтому все пользователи должны подключать данные по одному и тому же пути. При этом в каталоге также располагается эксклюзивный файл PARADOX.LCK. Это делается для того, чтобы предохранить те версии Paradox или Engine, которые используют старую блокировочную систему, от неумышленного получения доступа к таблицам.

Рабочие каталоги и каталоги общего доступа
Когда Paradox или Database Desktop необходимо получить доступ к таблицам, расположенным в каталоге, то в этом каталоге они размещают "общий" файл PDOXUSRS.LCK и "эксклюзивный" файл PARADOX.LCK. Этим способом они "метят" каталог для того, чтобы другие пользователи Paradox 4.0 также могли иметь доступ к таблицам, расположенным в данном каталоге. Эксклюзивный файл PARADOX.LCK устанавливается в этом каталоге для обеспечения работы несовместимого протокола блокировки, и, таким образом, для уменьшения риска при постинге данных. В Paradox'е этот каталог известен как рабочий, "Working" каталог.

Частные/эксклюзивные каталоги
Для Paradox и Database Desktop также необходим каталог, где они могли бы сохранять временные файлы, например, результаты запроса. При запуске Paradox или Paradox Runtime, они также размещают в каталоге "эксклюзивные" файлы PDOXUSRS.LCK и PARADOX.LCK, определяя данный каталог как место для хранения временных файлов. Это обозначает, что другие пользователи Paradox не смогут получить доступ к таблицам в этом каталоге. В Paradox'е этот каталог известен как частный, "Private" каталог.

Блокировка таблицы
Paradox 4.0 размещает каждую табличную блокировку в блокирующем файле PDOXUSRS.LCK, располагаемом в каталоге с таблицами. Теперь нет необходимости в использовании отдельного блокирующего файла для каждой таблицы, как это было в предыдущих версиях. Например, если три пользователя просматривают таблицу CUSTOMER.DB и один пользователь реструктуризирует таблицу ORDERS.DB, то файл PDOXUSRS.LCK будет иметь общую блокировку, указывающую на каждого из тех трех пользователей, просматривающих таблицу CUSTOMER.DB, и эксклюзивную блокировку на ORDERS.DB для пользователя, реструктуризирующего таблицу.

Протокол блокировки параллельности Paradox 4.0 (Locking Protocol Concurrency)
В многопользовательской среде протокол блокировки Paradox 4.0 поддерживает параллелизм, т.е. одновременное использование приложений, через файл PDOXUSRS.NET. Все пользователи, которые хотят иметь общий доступ к таблицам Paradox, должны иметь один и тот же путь к файлу PDOXUSRS.NET, но при этом логическая буква сетевого диска может отличаться. Для того, чтобы предотвратить доступ к файлам, расположенным в каталоге, предыдущим версиям, Paradox размещает PDOXUSRS.LCK и эксклюзивный файл PARADOX.LCK в каждом каталоге, где имеются доступные таблицы. Каждый пользователь, который хочет дать общий доступ к таблице в этом каталоге, должен подключить этот каталог с одним и тем же путем, с использованием одного логического сетевого диска и пути. Затем Paradox разместит всю информацию о блокировках для этой таблице в файле PDOXUSRS.LCK, уменьшая этим количество необходимых файлов.

Сетевой управляющий файл (Network Control File)
Сетевой управляющий файл Paradox, PDOXUSRS.NET, служит в качестве контрольной точки для всех блокирующих файлов, создаваемых Paradox. Net-файл содержит список пользователей, в настоящий момент использующих BDE, вместе со списком используемых ими таблиц. Каждый блокирующий файл ссылается на сетевой управляющий файл и содержит информацию о блокировках таблицы и пользователях, заблокировавших эти таблицы, поэтому все пользователи должны иметь один и тот же путь к сетевому управляющему файлу, но при этом логическая буква сетевого диска может отличаться.

Например, если вы используете том DATA на сервере SERVER_1, и сетевой управляющий файл расположен в каталоге \PDOXDATA, то все пользователи должны использовать путь \\SERVER_1\DATA:\PDOXDATA, тем не менее, любой пользователь может при этом использовать свою логическую букву сетевого диска. Если в вашей сети не пользуют тома, DATA должен быть корневым каталогом SERVER_1.

Если вы подключаете \\SERVER_1\DATA в корень диска P, то каждая система Paradox должна определять расположение PARADOX.NET как P:\PDOXDATA\. Тем не менее, другие пользователи могут подключить \\SERVER_1\DATA к корневому каталогу O и установить O:\PDOXDATA\ как местоположение сетевого управляющего файла.

Конфигурирование 16-битного Database Engine / IDAPI.CFG
Файл конфигурации Database Engine хранит специфическую сетевую информацию, список псевдонимов баз дынных и другую информацию. Вы можете конфигурировать IDAPI с помощью программы конфигурации Database Engine, BDECFG.EXE, и устанавливать с помощью нее месторасположение сетевого управляющего файла. Также возможно добавление, удаление и изменение псевдонимов баз данных (включая информацию об используемом драйвере и типе псевдонима), каким способом IDAPI осуществляет общий доступ к локальным таблицам для программ, использующих протокол блокировки Paradox 4.0, а также некоторые особенности относительно таблиц и способа отображения данных.

Локальные 16-битные установки
Файл WIN.INI содержит путь к файлу IDAPI.CFG, "рабочему" ("Working") каталогу Database Desktop и "частному" ("Private") каталогу Database Desktop. Для изменения этих значений необходимо загрузить файл WIN.INI в любой текстовый редактор и отредактировать его. Путь к файлу IDAPI.CFG описан в группе [IDAPI] как CONFIGFILE=<полный диск, путь и имя файла> или CONFIGFILE01=<полный диск, путь и имя файла>.

Месторасположение "рабочего" ("Working") и "частного" ("Private") каталога Database Desktop описано в группе [DBD] соответственно как WORKDIR=<полный диск и каталог> и PRIVDIR=<полный диск и каталог>.

Конфигурирование 32-битного Database Engine / IDAPI32.CFG
Конфигурационный файл BDE хранит ту же информацию, что и конфигурационный файл Database Engine. Для конфигурирования IDAPI32.CFG используется утилита BDE Configuration, BDECFG32.EXE. Вдобавок к этому, вы можете сохранять информацию в регистрах, или сразу, и в регистрах, и в IDAPI32.CFG.

Локальные 32-битные установки
В регистрах содержится путь к IDAPI32.CFG, к "рабочему" ("Working") и частному ("Private") каталогу. Месторасположение файла IDAPI32.CFG хранится в ключе HKEY_LOCAL_MACHINE\Software\Borland\Database Engine. Значение CONFIGFILE01 содержит данные типа <полный диск, путь и имя файла>.

Месторасположение каталогов BDE "Working" и "Private" хранится соответственно в ключах HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\WorkDir и HKEY_CURRENT_USER\Software\Borland\DBD\7.0\Configuration\PrivDir. По умолчанию, данные для каждого каталога хранятся в виде <Полный диск и каталог>.

Доступ к таблицам Paradox
BDE сначала пытается получить доступ к файлу PDOXUSRS.NET. Если файл PDOXUSRS.NET не найден, Paradox создает новый файл PDOXUSRS.NET и продолжает процедуру запуска. Если файл PDOXUSRS.NET присутствует, но владелец этого net-файла использует другой путь, т.е. подключил сервер иначе, возникает исключительная ситуация "Multiple net files in use" (Используются несколько net-файлов) и BDE прекращает свою работу. После того, как сеть успешно открыла эксклюзивную блокировку, PARADOX.LCK размещается во временном, частном каталоге. При невозможности установки блокировки, BDE прекращает свою работу. Причина неудачи может заключаться в том, что какой-то пользователь имеет в этом каталоге эксклюзивную блокировку, или же файлы блокировки используют различные net-файлы. После того, как каталог будет защищен от частного использования, общий файл PARADOX.LCK будет расположен в рабочем каталоге, и на этом процесс инициализации будет завершен.




Обратные вызовы BDE32 для получения статуса операций

Больница совершила недопустимую операцию и будет закрыта...

Данный совет показывает как в Delphi 2.01 можно использовать функцию BDE DbiCallBack для получения значения линейки прогресса при длительных пакетных операциях, связанных с движением данных.

Дополнительная документация, описывающая вызовы функций BDE, находится в файле BDE32.HLP (расположенном в каталоге, где установлен 32-битный IDAPI).

При создании функций обратного вызова BDE, BDE будет осуществлять "обратный вызов" функций вашего приложения, позволяя тем самым извещать ваше приложение о происходящих событиях, а в некоторых случаях передавать информацию обратно BDE.

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

           состояние больших пакетных операций.
            запросы для передачи информации вызывающему оператору.
Данный совет подробно описывает обратный вызов типа cbGENPROGRESS, позволяющий изменять полоску прогресса в соответствии с состоянием операции.

Чтобы это сделать, необходимо сперва вызвать функцию DbiGetCallBack(), возвращающую дескриптор обратного вызова, который мог быть уже установлен (с этими параметрами), и сохранить информацию в структуре данных. Затем установить свой обратный вызов, заменяя им любой установленный до этого.

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

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

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

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

----- Демонстрационный код ---------


 unit Testbc1;
 
 interface
 
 uses
   Windows, Messages, SysUtils, Classes, Graphics, Controls,
   Forms, Dialogs, StdCtrls, Grids, DBGrids, DB, DBTables, ComCtrls;
 
 type
   TForm1 = class(TForm)
     Table1: TTable;
     BatchMove1: TBatchMove;
     Table2: TTable;
     Button1: TButton;
     ProgressBar1: TProgressBar;
     procedure Button1Click(Sender: TObject);
   private
     { Private declarations }
   public
     { Public declarations }
   end;
 
 var
   Form1: TForm1;
 
 implementation
 
 uses Bde; {Здесь расположены Dbi Types и Procs}
 
 {$R *.DFM}
 
 {тип структуры данных для сохранения информации о предыдущем обратном вызове}
 type
   TDbiCbInfo = record
     ecbType: CBType;
     iClientData: longint;
     DataBuffLn: word;
     DataBuff: pCBPROGRESSDesc;
     DbiCbFn: pointer;
   end;
 type
   PDbiCbInfo = ^TDbiCbInfo;
 
   {Наша функция обратного вызова}
 
 function DbiCbFn(ecbType: CBType;
   iClientData: Longint;
   CbInfo: pointer): CBRType stdcall;
 var
   s: string;
 begin
   {Проверяем, является ли тип обратного вызова тем, который мы ожидаем}
   if ecbType = cbGENPROGRESS then
   begin
     {если iPercentDone меньше нуля, извлекаем число}
     {обработанных записей из параметра szMsg}
     if pCBPROGRESSDesc(cbInfo).iPercentDone < 0 then
     begin
       s := pCBPROGRESSDesc(cbInfo).szMsg;
       Delete(s, 1, Pos(': ', s) + 1);
       {Вычислям процент выполненного и изменяем линейку прогресса}
       Form1.ProgressBar1.Position :=
         Round((StrToInt(s) / Form1.Table1.RecordCount) * 100);
     end
     else
     begin
       {Устанавливаем линейку прогресса}
       Form1.ProgressBar1.Position :=
         pCBPROGRESSDesc(cbInfo).iPercentDone;
     end;
   end;
   {существовал ли предыдущий зарегистрированный обратный вызов?}
   {если так - осуществляем вызов и возвращаемся}
   if PDbiCbInfo(iClientData)^.DbiCbFn <> nil then
     DbiCbFn :=
       pfDBICallBack(PDbiCbInfo(iClientData)^.DbiCbFn)
       (ecbType,
       PDbiCbInfo(iClientData)^.iClientData,
       cbInfo)
   else
     DbiCbFn := cbrCONTINUE;
 end;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   CbDataBuff: CBPROGRESSDesc; {Структура DBi}
   {структура данных должна хранить информацию о предыдущем обратном вызове}
   OldDbiCbInfo: TDbiCbInfo;
 begin
   {Убедимся в том, что перемещаемая таблица открыта}
   Table1.Open;
   {Убедимся в том, что таблица-приемник закрыта}
   Table2.Close;
   {получаем информацию о любом установленном обратном вызове}
   DbiGetCallBack(Table2.Handle,
     cbGENPROGRESS,
     @OldDbiCbInfo.iClientData,
     @OldDbiCbInfo.DataBuffLn,
     @OldDbiCbInfo.DataBuff,
     pfDBICallBack(OldDbiCbInfo.DbiCbFn));
   {регистрируем наш обратный вызов}
   DbiRegisterCallBack(Table2.Handle,
     cbGENPROGRESS,
     longint(@OldDbiCbInfo),
     SizeOf(cbDataBuff),
     @cbDataBuff,
     @DbiCbFn);
 
   Form1.ProgressBar1.Position := 0;
   BatchMove1.Execute;
 
   {если предыдущий обратный вызов существовал - вновь устанавливаем его,}
   {в противном случае "отрегистрируем" наш обратный вызов}
   if OldDbiCbInfo.DbiCbFn <> nil then
     DbiRegisterCallBack(Table2.Handle,
       cbGENPROGRESS,
       OldDbiCbInfo.iClientData,
       OldDbiCbInfo.DataBuffLn,
       OldDbiCbInfo.DataBuff,
       OldDbiCbInfo.DbiCbFn)
   else
     DbiRegisterCallBack(Table2.Handle,
       cbGENPROGRESS,
       longint(@OldDbiCbInfo),
       SizeOf(cbDataBuff),
       @cbDataBuff,
       nil);
 
   {Показываем наш успех!}
   Table2.Open;
 
 end;
 
 end.
 




Копирование таблицы с помощью DBE


 function CopyTable(tbl: TTable; dest: string): boolean;
 var
   psrc, pdest: array[0..DBIMAXTBLNAMELEN] of char;
   rslt: DBIResult;
 begin
   Result := False;
   StrPCopy(pdest, dest);
   with tbl do
   begin
     try
       DisableControls;
       StrPCopy(psrc, TableName);
       rslt := DbiCopyTable(DBHandle, True, psrc, nil, pdest);
       Result := (rslt = 0);
     finally
       Refresh;
       EnableControls;
     end;
   end;
 end;
 




<< ВЕРНУТЬСЯ В ОГЛАВЛЕНИЕ



Материалы находятся на сайте https://exelab.ru/pro/



Оригинальный DVD-ROM: eXeL@B DVD !


Вы находитесь на EXELAB.rU
Проект ReactOS