Сохранить в базе картинку формата JPEG

Сохранить в базе картинку формата JPEG

usesJPEG;
...
if Picture.Graphic is TJPegImage then
begin
  bs:=TBlobStream.Create(TBlobField(Field),bmWrite);
  Picture.Graphic.SaveToStream(bs);
  bs.Free;
end
else if Picture.Graphic is TBitmap then


begin
  Jpg:=TJPegImage.Create;
  Jpg.CompressionQuality:=...;
  Jpg.PixelFormat:=...;
  Jpg.Assign(Picture.Graphic);
  Jpg.JPEGNeeded;
  bs:=TBlobStream.Create(TBlobField(Field),bmWrite);
  Jpg.SaveToStream(bs);
  bs.Free;
  Jpg.Free;
end 
else 
  Field.Clear; 

Взято из

Сообщения Windows

Сообщения Windows

Cодержание раздела:

Соответствие типов С++ и Delphi

Соответствие типов С++ и Delphi

C Data Type | Object Pascal |  Description 
----------------------------------------------
LPSTR       PAnsiChar;  String >pointer 
LPCSTR      PAnsiChar;  String >pointer 
DWORD       Integer;    Whole numbers 
BOOL        LongBool;   Boolean values 
PBOOL       ^BOOL;      Pointer to a Boolean value 
Pbyte       ^Byte;      Pointer to a byte value 
PINT        ^Integer;   Pointer to an integer value 
Psingle     ^Single;    Pointer to a single (floating point) value 
PWORD       ^Word;      Pointer to a 16-bit value 
PDWORD      ^DWORD;     Pointer to a 32-bit value 
LPDWORD     PDWORD;     Pointer to a 32-bit value 
UCHAR       Byte;       8-bit values (can represent characters) 
PUCHAR      ^Byte;      Pointer to 8-bit values 
SHORT       Smallint;   16-bit whole numbers 
UINT        Integer;    32-bit whole numbers. Traditionally, 
                        this was used to represent unsigned integers, 
                        but Object Pascal does not have a true 
                        unsigned integer data type. 
PUINT       ^UINT;      Pointer to 32-bit whole numbers 
ULONG       Longint;    32-bit whole numbers. Traditionally, 
                        this was used to represent unsigned integers, 
                        but Object Pascal does not have a true 
                        unsigned integer data type. 
PULONG      ^ULONG;     Pointer to 32-bit whole numbers 
PLongint    ^Longint;   Pointer to 32-bit values 
PInteger    ^Integer;   Pointer to 32-bit values 
PSmallInt   ^Smallint;  Pointer to 16-bit values 
PDouble     ^Double;    Pointer to double (floating point) values 
LCID        DWORD;      A local identifier 
LANGID      Word;       A language identifier 
THandle     Integer;    An object handle. Many Windows API functions return a value 
                        of type THandle, which identobject ifies that object within 
                        Windows'internal object tracking tables. 
PHandle     ^THandle;   A pointer to a handle 
WPARAM      Longint;    A 32-bit message parameter. Under earlier versions of Windows, 
                        this was a 16-bit data type. 
LPARAM      Longint;    A 32-bit message parameter 
LRESULT     Longint;    A 32-bit function return value 
HWND        Integer;    A handle to a window. All windowed controls, child windows, 
                        main windows, etc., have a corresponding window handle that 
                        identifies them within Windows'internal tracking tables. 
HHOOK       Integer;    A handle to an installed Windows system hook 
ATOM        Word;       An index into the local or global atom table for a string 
HGLOBAL     THandle;    A handle identifying a globally allocated dynamic memory object. 
                        Under 32-bit Windows, there is no distinction between globally 
                        and locally allocated memory. 
HLOCAL      THandle;    A handle identifying a locally allocated dynamic memory object. 
                        Under 32-bit Windows, there is no distinction between globally 
                        and locally allocated memory. 
FARPROC     Pointer;    A pointer to a procedure, usually used as a parameter type in 
                        functions that require a callback function 
HGDIOBJ     Integer;    A handle to a GDI object. Pens, device contexts, brushes, etc., 
                        all have a handle of this type that identifies them within 
                        Windows'internal tracking tables. 
HBITMAP     Integer;    A handle to a Windows bitmap object 
HBRUSH      Integer;    A handle to a Windows brush object 
HDC         Integer;    A handle to a device context 
HENHMETAFILE  Integer;  A handle to a Windows enhanced metafile object 
HFONT       Integer;    A handle to a Windows logical font object 
HICON       Integer;    A handle to a Windows icon object 
HMENU       Integer;    A handle to a Windows menu object 
HMETAFILE   Integer;    A handle to a Windows metafile object 
HINST       Integer;    A handle to an instance object 
HMODULE     HINST;      A handle to a module 
HPALETTE    Integer;    A handle to a Windows color palette 
HPEN        Integer;    A handle to a Windows pen object 
HRGN        Integer;    A handle to a Windows region object 
HRSRC       Integer;    A handle to a Windows resource object 
HKL         Integer;    A handle to a keyboard layout 
HFILE       Integer;    A handle to an open file 
HCURSOR     HICON;      A handle to a Windows mouse cursor object 
COLORREF    DWORD;      A Windows color reference value, containing values 
                        for the red, green, and of ;bsp;blue components of a color 


Взято с сайта

Сортировка

Сортировка

Cодержание раздела:






См. также статьи в других разделах:

Сортировка DBGrid по клику на колонке?

Сортировка DBGrid по клику на колонке?

На форме расположены TQuery, TDatasource и TDbGrid связанные вместе.

QuerySQL, это глобальная строка, которая содержит SQL-выражение.

begin
  QuerySQL := 'SELECT * FROM Customer.DB'; 
  Query1.SQL.Add(QuerySQL); 
  Query1.Open; 
end; 


В DBGrid в событии OnTitleClick, достаточно добавить ORDER-BY к sql-строке и обновить запрос.

procedure TForm1.DBGrid1TitleClick(Column: TColumn); 
begin 
  witzh Query1 do 
  begin 
    DisableControls; 
    Close; 
    SQL.Clear; 
    SQL.Add(QuerySQL); 
    SQL.Add('ORDER BY ' + Column.FieldName); 
    Open; 
    // Восстанавливаем настройки заголовка, иначе всё станет синим
    DBGrid1.Columns.RestoreDefaults; 
    Column.Title.Font.Color := clBlue; 
    EnableControls; 
  end; 
end; 

Взято с Исходников.ru


Кyсочек кода, чтобы повесить на clickable столбец RxGrid, показывающий RxQuery с опpеделенным макpосом %Order. Работать не бyдет (без модyлей), но в качестве идеи может быть полезен.

unit vgRXutil;

interface

uses
  SysUtils, Classes, DB, DBTables, rxLookup, RxQuery;

{ TrxDBLookup }
procedure RefreshRXLookup(Lookup: TrxLookupControl);
procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;

{ TRxQuery }

{ Applicatable to SQL's without SELECT * syntax }

{ Inserts FieldName into first position in '%Order' macro and refreshes query }
procedure HandleOrderMacro(Query: TRxQuery; Field: TField);

{ Sets '%Order' macro, if defined, and refreshes query }
procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);

{ Converts list of order fields if defined and refreshes query }
procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);

implementation
uses
  vgUtils, vgDBUtl, vgBDEUtl;

{ TrxDBLookup refresh }

type
  TRXLookupControlHack = class(TrxLookupControl)
    property DataSource;
    property LookupSource;
    property Value;
    property EmptyValue;
  end;

procedure RefreshRXLookup(Lookup: TrxLookupControl);
var
  SaveField: string;
begin
  with TRXLookupControlHack(Lookup) do
  begin
    SaveField := DataField;
    DataField := '';
    DataField := SaveField;
  end;
end;

procedure RefreshRXLookupLookupSource(Lookup: TrxLookupControl);
var
  SaveField: string;
begin
  with TRXLookupControlHack(Lookup) do
  begin
    SaveField := LookupDisplay;
    LookupDisplay := '';
    LookupDisplay := SaveField;
  end;
end;

function RxLookupValueInteger(Lookup: TrxLookupControl): Integer;
begin
  with TRXLookupControlHack(Lookup) do
  try
    if Value <> EmptyValue then
      Result := StrToInt(Value)
    else
      Result := 0;
  except
    Result := 0;
  end;
end;

procedure InsertOrderBy(Query: TRxQuery; NewOrder: string);
var
  Param: TParam;
  OldActive: Boolean;
  OldOrder: string;
  Bmk: TPKBookMark;
begin
  Param := FindParam(Query.Macros, 'Order');
  if not Assigned(Param) then
    Exit;

  OldOrder := Param.AsString;

  if OldOrder <> NewOrder then
  begin
    OldActive := Query.Active;
    if OldActive then
      Bmk := GetPKBookmark(Query, '');
    try
      Query.Close;
      Param.AsString := NewOrder;
      try
        Query.Prepare;
      except
        Param.AsString := OldOrder;
      end;
      Query.Active := OldActive;
      if OldActive then
        SetToPKBookMark(Query, Bmk);
    finally
      if OldActive then
        FreePKBookmark(Bmk);
    end;
  end;
end;

procedure UpdateOrderFields(Query: TQuery; OrderFields: TStrings);
var
  NewOrderFields: TStrings;

  procedure AddOrderField(S: string);
  begin
    if NewOrderFields.IndexOf(S) < 0 then
      NewOrderFields.Add(S);
  end;

var
  I, J: Integer;
  Field: TField;
  FieldDef: TFieldDef;
  S: string;
begin
  NewOrderFields := TStringList.Create;
  with Query do
  try
    for I := 0 to OrderFields.Count - 1 do
    begin
      S := OrderFields[I];
      Field := FindField(S);
      if Assigned(Field) and (Field.FieldNo > 0) then
        AddOrderField(IntToStr(Field.FieldNo))
      else
      try
        J := StrToInt(S);
        if J < FieldDefs.Count then
          AddOrderField(IntToStr(J));
      except
      end;
    end;
    OrderFields.Assign(NewOrderFields);
  finally
    NewOrderFields.Free;
  end;
end;

procedure HandleOrderMacro(Query: TRxQuery; Field: TField);
var
  Param: TParam;
  Tmp, OldOrder, NewOrder: string;
  I: Integer;
  C: Char;
  TmpField: TField;
  OrderFields: TStrings;
begin
  Param := FindParam(Query.Macros, 'Order');
  if not Assigned(Param) or Field.Calculated or Field.Lookup then
    Exit;
  OldOrder := Param.AsString;
  I := 0;
  Tmp := '';
  OrderFields := TStringList.Create;
  try
    OrderFields.Ad(Field.FieldName);
    while I < Length(OldOrder) do
    begin
      Inc(I);
      C := OldOrder[I];
      if C in FieldNameChars then
        Tmp := Tmp + C;

      if (not (C in FieldNameChars) or (I = Length(OldOrder))) and (Tmp <> '')
        then
      begin
        TmpField := Field.DataSet.FindField(Tmp);
        if OrderFields.IndexOf(Tmp) < 0 then
          OrderFields.Add(Tmp);
        Tmp := '';
      end;
    end;

    UpdateOrderFields(Query, OrderFields);
    NewOrder := OrderFields[0];
    for I := 1 to OrderFields.Count - 1 do
      NewOrder := NewOrder + ', ' + OrderFields[1];
  finally
    OrderFields.Free;
  end;
  InsertOrderBy(Query, NewOrder);
end;

end.

 

Автор: Nomadic

Взято из

Сортировка ListView при нажатии на заголовок

Сортировка ListView при нажатии на заголовок

Взято из FAQ:

Сортировка ListView в режиме vsReport при нажатии на заголовок колонки


function CustomDateSortProc(Item1, Item2: TListItem; ParamSort: integer): integer; stdcall;
begin
result:=0;  
if strtodatetime(item1.SubItems[0])> strtodatetime(item2.SubItems[0]) then  
  Result :=1   
else  
  if strtodatetime(item1.SubItems[0])< strtodatetime(item2.SubItems[0]) then  
    Result :=-1;  
end; 

procedure TForm1.lv1ColumnClick(Sender: TObject; Column: TListColumn);
begin
if column =lv1.columns[0] then  
  LV1.CustomSort(@CustomNameSortProc, 0)  
else   
  LV1.CustomSort(@CustomDateSortProc, 0)  
end; 

Автор Vit
Взято с Vingrad.ru



Сортировка по первой колонке
Сортировка по первой колонке TListView делается так:

ListView1.SortType := stText;

Установка SortType в stText аналогична установке Sorted в True в объекте TListBox. Список будет оставаться отсортированным даже после добавления или изменения элементов, до тех пор, пока не установить SortType обратно в stNone:

ListView1.SortType := stNone;

В TListBox это аналогично установке Sorted в False.

Сортировка по другим колонкам
Чтобы отсортировать TListView по другой колонке, потребуется написать событие OnCompare, либо функцию сортировки, которая будет использоваться в методе CustomSort.

Для начала рассмотрим сортировку при помощи события OnCompare.

procedure(Sender: TObject; Item1, Item2: TListItem;Data: Integer; var Compare: Integer) of object;

Параметр Compare может иметь три значения: 1, -1 или 0. Единица означает, что первый элемент больше (или должен быть размещён после) второго элемента. Минус одни означает, что первый элемент меньше чем (или должен быть размещён перед) второй элемент. Ноль означает, что два элемента равны.

В следующем примере мы сортируем TListView по четвёртой колонке (которая представлена целыми значениями) в порядке убывания:

procedure TForm1.ListView1Compare(Sender: TObject; Item1,
  Item2: TListItem; Data: Integer; var Compare: Integer);
var
  n1, n2: integer;
begin
  n1 := StrToInt(Item1.SubItems[2]);
  n2 := StrToInt(Item2.SubItems[2]);
  if n1 > n2 then
    Compare := -1
  else if n1 < n2 then
    Compare := 1
  else
    Compare := 0;
end;

Теперь достаточно установить SortType в stBoth (вместо stText, который сортирует по первой колонке не используя метод OnCompare):

ListView1.SortType := stBoth; 

Теперь, чтобы сделать временную сортировку, проделайте следующее:

ListView1.SortType := stBoth;
ListView1.SortType := stNone;

или ещё:

ListView1.CustomSort(nil, 0);

Сортировка при помощи функции сортировки
Функция сортировки используется для быстрой сортировки. Эта функция должна возвращать 1, -1 или 0 (как параметр Compare в событии OnCompare). Например:

function ByFourth(Item1, Item2: TListItem; Data: integer):
  integer; stdcall;
var
  n1, n2: cardinal;
begin
  n1 := StrToInt(Item1.SubItems[2]);
  n2 := StrToInt(Item2.SubItems[2]);
  if n1 > n2 then
    Result := -1
  else if n1 < n2 then
    Result := 1
  else
    Result := 0;
end;

Теперь, каждый раз, как Вы захотите отсортировать список, достаточно будет вызвать метод CustomSort, передав ему адрес функции сортировки. Например:

ListView1.CustomSort(@ByFourth, 0);

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


Взято с Исходников.ru

Сортировка столбцов в StringGrid

Сортировка столбцов в StringGrid

Procedure GridSort(StrGrid: TStringGrid; NoColumn: Integer); 
Var Line, PosActual: Integer; 
    Row: TStrings; 
begin 
  Renglon := TStringList.Create; 
  For Line := 1 to StrGrid.RowCount-1 do 
  Begin 
    PosActual := Line; 
    Row.Assign(TStringlist(StrGrid.Rows[PosActual])); 
    While True do 
    Begin 
      If (PosActual = 0) Or (StrToInt(Row.Strings[NoColumn-1]) >= 
          StrToInt(StrGrid.Cells[NoColumn-1,PosActual-1])) then 
        Break; 
      StrGrid.Rows[PosActual] := StrGrid.Rows[PosActual-1]; 
      Dec(PosActual); 
    End; 
    If StrToInt(Row.Strings[NoColumn-1]) < StrToInt(StrGrid.Cells[NoColumn-1,PosActual]) then 
      StrGrid.Rows[PosActual] := Row; 
  End; 
  Renglon.Free; 
end;



type TStringGridExSortType = (srtAlpha,srtInteger,srtDouble); 

procedure GridSort(SG : TStringGrid; ByColNumber,FromRow,ToRow : integer; 
                   SortType : TStringGridExSortType = srtAlpha); 
var Temp : TStringList; 

    function SortStr(Line : string) : string; 
    var RetVar : string; 
    begin 
      case SortType of 
           srtAlpha   : Retvar := Line; 
           srtInteger : Retvar := FormatFloat('000000000',StrToIntDef(trim(Line),0)); 
           srtDouble  : try 
                          Retvar := FormatFloat('000000000.000000',StrToFloat(trim(Line))); 
                        except 
                          RetVar  := '0.00'; 
                        end; 
      end; 

      Result := RetVar; 
    end; 

    // Рекурсивный QuickSort 
    procedure QuickSort(Lo,Hi : integer; CC : TStrings); 

        procedure Sort(l,r: integer); 
        var  i,j : integer; 
             x   : string; 
        begin 
          i := l; j := r; 
          x := SortStr(CC[(l+r) DIV 2]); 
          repeat 
            while SortStr(CC[i]) < x do inc(i); 
            while x < SortStr(CC[j]) do dec(j); 
            if i <= j then begin 
              Temp.Assign(SG.Rows[j]);      // Меняем местами 2 строки
              SG.Rows[j].Assign(SG.Rows[i]); 
              SG.Rows[i].Assign(Temp); 
              inc(i); dec(j); 
            end; 
          until i > j; 
          if l < j then sort(l,j); 
          if i < r then sort(i,r); 
        end; 

     begin {quicksort}; 
       Sort(Lo,Hi); 
     end; 

begin 
  Temp := TStringList.Create; 
  QuickSort(FromRow,ToRow,SG.Cols[ByColNumber]); 
  Temp.Free; 
end;

Взято с Исходников.ru

Сортировка связанного списка

Сортировка связанного списка

programnoname;

type
  PData = ^TData;
  TData = record
    next: PData;
    Name: string[40];
    { ...другие поля данных }
  end;

var
  root: PData; { это указатель на первую запись в связанном списке }

procedure InsertRecord(var root: PData; pItem: PData);
{ вставляем запись, на которую указывает pItem в список начиная
с root и с требуемым порядком сортировки }
var
  pWalk, pLast: PData;
begin
  if root = nil then
  begin
    { новый список все еще пуст, просто делаем запись,
    чтобы добавить root к новому списку }
    root := pItem;
    root^.next := nil
  end { If }
  else
  begin
    { проходимся по списку и сравниваем каждую запись с одной
    включаемой. Нам необходимо помнить последнюю запись,
    которую мы проверили, причина этого станет ясна немного позже. }
    pWalk := root;
    pLast := nil;

    { условие в следующем цикле While определяет порядок сортировки!
    Это идеальное место для передачи вызова функции сравнения,
    которой вы передаете дополнительный параметр InsertRecord для
    осуществления общей сортировки, например:

    While CompareItems( pWalk, pItem ) < 0 Do Begin
    where
    Procedure InsertRecord( Var list: PData; CompareItems: TCompareItems );
    and
    Type TCompareItems = Function( p1,p2:PData ): Integer;
    and a sample compare function:
    Function CompareName( p1,p2:PData ): Integer;
    Begin
    If p1^.Name < p2^.Name Then
    CompareName := -1
    Else
    If p1^.Name > p2^.Name Then
    CompareName := 1
    Else
    CompareName := 0;
    End;
    }
    while pWalk^.Name < pItem^.Name do
      if pWalk^.next = nil then
      begin
        { мы обнаружили конец списка, поэтому добавляем
        новую запись и выходим из процедуры }
        pWalk^.next := pItem;
        pItem^.next := nil;
        Exit;
      end { If }
      else
      begin
        { следующая запись, пожалуйста, но помните,
        что одну мы только что проверили! }
        pLast := pWalk;

        { если мы заканчиваем в этом месте, то значит мы нашли
        в списке запись, которая >= одной включенной. Поэтому
        вставьте ее перед записью, на которую в настоящий момент
        указывает pWalk, которая расположена после pLast. }
        if pLast = nil then
        begin
          { Упс, мы вывалились из цикла While на самой первой итерации!
          Новая запись должна располагаться в верхней части списка,
          поэтому она становится новым корнем (root)! }
          pItem^.next := root;
          root := pItem;
        end { If }
        else
        begin
          { вставляем pItem между pLast и pWalk }
          pItem^.next := pWalk;
          pLast^.next := pItem;
        end; { Else }
        { мы сделали это! }
      end; { Else }
  end; { InsertRecord }

procedure SortbyName(var list: PData);
var

  newtree, temp, stump: PData;
begin { SortByName }

  { немедленно выходим, если сортировать нечего }
  if list = nil then
    Exit;
  { в
  newtree := Nil;}

  {********
  Сортируем, просто беря записи из оригинального списка и вставляя их
  в новый, по пути "перехватывая" для определения правильной позиции в
  новом дереве. Stump используется для компенсации различий списков.
  temp используется для указания на запись, перемещаемую из одного
  списка в другой.
  ********}
  stump := list;
  while stump <> nil do
  begin
    { временная ссылка на перемещаемую запись }
    temp := stump;
    { "отключаем" ее от списка }
    stump := stump^.next;
    { вставляем ее в новый список }
    InsertRecord(newtree, temp);
  end; { While }

  { теперь помещаем начало нового, сортированного
  дерева в начало старого списка }
  list := newtree;
end; { SortByName }
begin

  New(root);
  root^.Name := 'BETA';
  New(root^.next);
  root^.next^.Name := 'ALPHA';
  New(root^.next^.next);
  root^.next^.next^.Name := 'Torture';

  WriteLn(root^.name);
  WriteLn(root^.next^.name);
  WriteLn(root^.next^.next^.name);
end.

Взято из

Состояние кнопки insert

Состояние кнопки insert

function InsertOn: Boolean;
begin
  Result:=LowOrderBitSet(GetKeyState(VK_INSERT));
end;

Источник: 
Исправлено by Vit

Создаём Excel файл без OLE

Создаём Excel файл без OLE

const
  CXlsBof: array[0..5] of Word = ($809, 8, 00, $10, 0, 0); 
  CXlsEof: array[0..1] of Word = ($0A, 00); 
  CXlsLabel: array[0..5] of Word = ($204, 0, 0, 0, 0, 0); 
  CXlsNumber: array[0..4] of Word = ($203, 14, 0, 0, 0); 
  CXlsRk: array[0..4] of Word = ($27E, 10, 0, 0, 0); 

procedure XlsBeginStream(XlsStream: TStream; const BuildNumber: Word); 
begin 
  CXlsBof[4] := BuildNumber; 
  XlsStream.WriteBuffer(CXlsBof, SizeOf(CXlsBof)); 
end; 

procedure XlsEndStream(XlsStream: TStream); 
begin 
  XlsStream.WriteBuffer(CXlsEof, SizeOf(CXlsEof)); 
end; 

procedure XlsWriteCellRk(XlsStream: TStream; const ACol, ARow: Word; 
  const AValue: Integer); 
var 
  V: Integer; 
begin 
  CXlsRk[2] := ARow; 
  CXlsRk[3] := ACol; 
  XlsStream.WriteBuffer(CXlsRk, SizeOf(CXlsRk)); 
  V := (AValue shl 2) or 2; 
  XlsStream.WriteBuffer(V, 4); 
end; 

procedure XlsWriteCellNumber(XlsStream: TStream; const ACol, ARow: Word; 
  const AValue: Double); 
begin 
  CXlsNumber[2] := ARow; 
  CXlsNumber[3] := ACol; 
  XlsStream.WriteBuffer(CXlsNumber, SizeOf(CXlsNumber)); 
  XlsStream.WriteBuffer(AValue, 8); 
end; 

procedure XlsWriteCellLabel(XlsStream: TStream; const ACol, ARow: Word; 
  const AValue: string); 
var 
  L: Word; 
begin 
  L := Length(AValue); 
  CXlsLabel[1] := 8 + L; 
  CXlsLabel[2] := ARow; 
  CXlsLabel[3] := ACol; 
  CXlsLabel[5] := L; 
  XlsStream.WriteBuffer(CXlsLabel, SizeOf(CXlsLabel)); 
  XlsStream.WriteBuffer(Pointer(AValue)^, L); 
end; 

procedure TForm1.Button1Click(Sender: TObject); 
var 
  FStream: TFileStream; 
  I, J: Integer; 
begin 
  FStream := TFileStream.Create('c:\e.xls', fmCreate); 
  try 
    XlsBeginStream(FStream, 0); 
    for I := 0 to 99 do 
      for J := 0 to 99 do 
      begin 
        XlsWriteCellNumber(FStream, I, J, 34.34); 
        // XlsWriteCellRk(FStream, I, J, 3434); 
        // XlsWriteCellLabel(FStream, I, J, Format('Cell: %d,%d', [I, J])); 
      end; 
    XlsEndStream(FStream); 
  finally 
    FStream.Free; 
  end; 
end;

Взято с

Создаём собственный UnRar, используя unrar.dll

Создаём собственный UnRar, используя unrar.dll

// Объявления

function RAROpenArchive(ArchiveData : Pointer): Integer; stdcall;
external 'unrar.dll' name 'RAROpenArchive'; 

function RARCloseArchive(hArcData : Integer): Integer; stdcall;
external 'unrar.dll' name 'RARCloseArchive';

function RARReadHeader(hArcData : Integer; HeaderData : Pointer): Integer; stdcall;
external 'unrar.dll' name 'RARReadHeader';

function RARProcessFile(hArcData : Integer; Operation : Integer; DestPath : Pointer;
DestName : Pointer): Integer; stdcall;
external 'unrar.dll' name 'RARProcessFile';


const
  ERAR_END_ARCHIVE = 10;
  ERAR_NO_MEMORY = 11;
  ERAR_BAD_DATA = 12;
  ERAR_BAD_ARCHIVE = 13;
  ERAR_UNKNOWN_FORMAT = 14;
  ERAR_EOPEN = 15;
  ERAR_ECREATE = 16;
  ERAR_ECLOSE = 17;
  ERAR_EREAD = 18;
  ERAR_EWRITE = 19;
  ERAR_SMALL_BUF = 20;

  RAR_OM_LIST = 0;
  RAR_OM_EXTRACT = 1;
  RAR_SKIP = 0;
  RAR_TEST = 1;
  RAR_EXTRACT = 2;
  RAR_VOL_ASK = 0;
  RAR_VOL_NOTIFY = 1;


type
  Char260 = Array [1..260] of Char;

  TRAROpenArchiveData = record
   ArcName : PChar; // в C++ это будет выглядеть как: char *ArcName
   OpenMode : Cardinal;
   OpenResult : Cardinal;
   CmtBuf : PChar;
   CmtBufSize : Cardinal;
   CmtSize : Cardinal;
   CmtState : Cardinal;
  end;

  TRARHeaderData = record
   ArcName : Char260;
   FileName : Char260;
   Flags : Cardinal;
   PackSize : Cardinal;
   UnpSize : Cardinal;
   HostOS : Cardinal;
   FileCRC : Cardinal;
   FileTime : Cardinal;
   UnpVer : Cardinal;
   Method : Cardinal;
   FileAttr : Cardinal;
   CmtBuf : PChar;
   CmtBufSize : Cardinal;
   CmtSize : Cardinal;
   CmtState : Cardinal;
  end;


var
  RARExtract : boolean;
  RAROpenArchiveData : TRAROpenArchiveData;
  RARComment : array [1..256] of Char;
  RARHeaderData : TRARHeaderData;

...

procedure ExtractRARArchive;
var
  sDir : string;
  s : string;
  sTest : string;
  iTest : integer;
  bTestDone : boolean;
  RARhnd : Integer;
  RARrc : Integer;
  PDestPath : Char260;

begin
  RARExtract:=TRUE;
  lKBWritten:=0;
  ProgressBar2.Position := 0;
  ProgressBar2.Max := lTotalSize;
  RARStartTime:=Time;

  RAROpenArchiveData.OpenResult:=99;
  RAROpenArchiveData.OpenMode := RAR_OM_EXTRACT; // открываем для распаковки
  RAROpenArchiveData.ArcName:= @RARFileName;
  RAROpenArchiveData.CmtBuf := @RARComment; 
  RAROpenArchiveData.CmtBufSize := 255; 

// Открываем RAR архив и выделяем память
  RARhnd := RAROpenArchive (@RAROpenArchiveData);
  If RAROpenArchiveData.OpenResult <> 0 then
  begin
   case RAROpenArchiveData.OpenResult of
    ERAR_NO_MEMORY : s:='Not enough memory to initialize data structures';
    ERAR_BAD_DATA : s:='Archive header broken';
    ERAR_BAD_ARCHIVE : s:='File is not valid RAR archive';
    ERAR_EOPEN : s:='File open error';
   end;
   MessageDlg('Unable to open rar archive: ' + s + '!',mtError, [mbOK], 0);
  end;

  RARSetProcessDataProc(RARhnd,@Form.OnRarStatus);
  StrPCopy(@PDestPath, EInstallPath.Text);

  repeat
   RARrc := RARReadHeader (RARhnd, @RARHeaderData);// Читаем заголовок
   if RARrc <> ERAR_END_ARCHIVE then
   begin
    ProgressBar1.Position := 0;
    ProgressBar1.Max := RARHeaderData.UnpSize;
    s:=RARHeaderData.FileName;
    lblCurrentFile.Caption := s;
    lKBytesDone := 0;
   end;

   if RARrc = 0 then
   RARrc:=RARProcessFile (RARhnd, RAR_EXTRACT, @PDestPath, nil);
   if (RARrc <> 0) and (RARrc <> ERAR_END_ARCHIVE) then
   begin
    MessageDlg('An Error occured during extracting of ' + sTest+'!' + #13#10 +
    'RARProcessFile: ' + MakeItAString(RARrc),mtError, [mbOK], 0);
   end;
  until RARrc <> 0;

// закрываем RAR архив и освобождаем память
  If RARCloseArchive(RARhnd) <> 0 then
  begin
   MessageDlg('Unable to close rar archive!',mtError, [mbOK], 0);
  end;
end; // ExtractRARArchive

Взято с Исходников.ru

Создание Active Server Page (ASP) приложений (Статья)

Создание Active Server Page (ASP) приложений (Статья)

Новый продукт Boorland ? Delphi5, который начал распространяться осенью 1999 года содержит ряд новых возможностей. В частности, к экспертам проектов была добавлена возможность создания ASP приложений. Эксперт вызывается при помощи команды File/New/ActiveX и далее выбирается икона Active Server Object. К сожалению, в текущей документации, распространяемой с Delphi 5 (Build 5.62), крайне скупо сказано о назначении, последовательности создания и тестирования ASP сервера. Примеры работающего ASP сервера также отсутствуют в дистрибутиве Delphi5. Настоящая публикация частично восполняет эти проблемы.
Клиентное приложение, работающее с ASP сервером, представляет собой HTML документ и может быть прочитано на любом WEB браузере. Соответственно, эти HTML документы размещаются на каком-либо WEB-сервере. WEB сервер, получив требование о предоставлении документа, считывает его из локального хранилища и передает клиенту, при этом часть информации вносится в документ динамически ASP сервером. Принято, чтобы расширения у документов, обращающиеся к ASP серверу, имели расширение *.asp. Примеры таких документов можно найти в директориях WINNT\SYSTEM32\INETSRV\IISADMIN и INETPUB\IISAMPLES\EXAIR если был установлен Microsoft Internet Informational Server (IIS). Типичный пример обращения к ASP серверу с HTML документа выглядит следующим образом:

<%
Set FileSystem=Server.CreateObject("Scripting.FileSystemObject")
FileSystem.FindAllFiles 
%>

Данная запись представляет собой Visual Basic (VB) скрипт. Несмотря на наличие VB скрипта, страница ASP может быть доступна клиентам, работающих на других операционных системах, например UNIX. На первый взгляд это может показаться странным: ведь UNIX компьютеры не имеет языка Basic, и тем более VB. Но дело в том, что скрипты в ASP документах выполняются на сервере и клиенту приходит HTML документ.
ASP сервер обязан быть установлен на Windows NT (Windows 98) операционной системе с запущенным IIS или Microsoft Personal Web Server (PWS) и этот факт снижает возможности широкого использования ASP сервера. По существу, ASP сервер представляет собой внутреннюю разработку компании Microsoft, которая не была (да и не могла быть) согласована с фактическими законодателями дальнейшего развития Internet-технологий (Sun, Netscape). В будущем не следует ожидать продвижения этой технологии на другие платформы, поскольку при реализации ASP ? серверов использовалась COM-технология, записи в системный реестр ? а это эксклюзивные разработки Microsoft. Более того, другие WEB-сервера, работающие на платформе Windows (Netscape, Apache), скорее всего не будут поддерживать ASP технологию, поскольку до сих пор производители этих серверов успешно игноировали все новые разработки Microsoft в этой области.
По существу, ASP сервер представляет собой сервер OLE автомации, в котором предопределено несколько интерфейсов, среди них ? IRequest и IResponse. IRequest содержит методы, вызов которых позволяют установить параметры, заполненные на клиенте ? об этом будет рассказано ниже. IResponse содержит методы, вызов которых приводит к формированию HTML документа и, как финал, передача данного документа клиенту. По этим признакам ASP сервер напоминает CGI приложения и ISAPI/NSAPI dll (далее ? WEB сервер приложения). Идеология выполнения методов в ASP сервере и WEB серверных приложениях также аналогична: анализируется (если требуется) запрос клиента и динамически формируется отклик. Отличие заключается в том, что WEB серверные приложения формируют целиком HTML документ, в то время как отклик ASP сервера вставляется в исходную HTML страницу. Например, если документ ASP представлен в виде:
<HTML>
<BODY>
<TITLE> Testing Delphi ASP </TITLE>
<CENTER>
<H3> You should see the results of your Delphi Active Server method below </H3>
</CENTER>
<HR>
<% Set DelphiASPObj = Server.CreateObject("ASP01.Test")
DelphiASPObj.ScriptContent
%>
<HR>
</BODY>
</HTML>
и результат выполнения метода ScriptContent возвращает строку 'First call to ASP server', то клиент, получивший данный документ, увидит следующее (рис. 1):

Рис.1 Результат выполнения запроса к простейшему ASP серверу.
То есть, отклик ASP сервера добавляется к HTML документу. В одном документе допустимо обращение к нескольким ASP серверам и результат их отклика формируется в единый документ. Этого невозможно достичь при использовании WEB приложений. Ограничение: набор ASP серверов, к которым обращаются из одного документа, обязаны быть зарегистрированы на одном IIS сервере. Нельзя обратиться по различным адресам для формирования одного HTML документа.
ASP сервер реализуется как в *.exe, так и в *.dll приложениях ? это разрешается при создании сервера OLE автомации. ASP сервер, реализованный в *.exe файле, запускается один раз в ответ на запрос клиента. При использовании внутренних (in-process) ASP серверов один экземпляр DLL, загруженный в оперативную память, способен обслуживать одновременно нескольких клиентов. При этом для каждого клиента может создаваться как отдельный экземпляр COM обьекта, так и единственный экземпляр COM обьекта может обслуживать нескольких клиентов. Это зависит от выбранной модели работы в потоках (Threading Model) при заполнении диалога при выборе команды File/New/ActiveX/Active Server Object.
Рассмотрим теперь, каким образом работает ASP сервер на конкретном примере создания внутреннего (in-process) ASP сервера. Ограничимся сервером, который выполняет один запрос. Выберем команду File/New/ActiveX/ActiveX Library и нажмем кнопку OK. Будет создан новый проект, который сохраним, например, под именем ASP01. Далее, вызовем из меню команду File/New/ActiveX/Active Server Object. В появляющемся диалоге определеим имя класса, например, Test. Поскольку создается in-process сервер, параметр Instancing не играет роли, зато имеет значение параметр Threading Model. Выбор параметра Single приводит к неэффективной работе сервера ? при одновременном к нему обращении нескольких клиентов, сервер выполняет запросы последовательно и если один из клиентов обращается с длительным запросом, то остальные вынуждены ожидать его окончания, даже если запросы у них короткие по времени. У них создается впечатление о зависании эксплорера и часто это приводит к попыткам прервать задачу разными методами. Выбор параметра Apartment приводит к разделению запросов клиентов по потокам, при этом для каждого клиента будет создан свой экземпляр COM обьекта ? в данном примере, класса TTest. При этом при написании методов класса не требуется защиты переменных класса по потокам ? клиент может свободно модифицироать их и это упрощает разработку кода приложения. Недостаток этоя модели ? проект ресурсоемкий и переменные класса инициализируются на каждое обращение, что удлиняет время отклика. Этих недостатков лишена модель Free, в которых единственный экземпляр COM обьекта обслуживает нескольких клиентов. Однако, если клиенты могут изменять данные, то это требует защиты общих переменных по потокам что существенно усложняет процедуру реализации кода приложения и является потенциальным источником трудноуловимых ошибок. Как правило, эту модель используют в серверах, которые только предоставляют данные, но клиент не может их модифицировать.
Группа контролей Active Server Type позволяет выбрать назначение ASP сервера. Если сервер планируется инсталлировать на компьютере, которым управляет IIS версии 3 или 4, то следует выбрать Page Level Events Methods. С IIS5 эта опция тоже работает, но эффективнее будет работать опция Object Context. Эту же опцию необходимо выбирать, если работой ASP управляет Microsoft Transaction Server (MTS). Фактически IIS5 также управляет этим сервером при помощи MTS ? оба этих продукта тесно интегрированы.
Опцию Generate a Template Test Script for this object следует оставлять всегда включенной ? Delphi в этом случае создаст небольшой HTML документ, который с небольшими изменениями можно использовать для тестирования ASP сервера.
После заполнения опций диалога следует нажать кнопку OK и после этого будет создан файл реализации интерфейсов Unit1.pas, который следует запомнить под разумным именем ? например: U1_01. Кроме того, будет создана библиотека типов, появится ее редактор и файл, описывающий библиотеку типов ? в данном примере TEST_TLB.pas. Если была выбрана опция Page Level Events Methods (как в данном примере), то библиотека типов будет содержать два предопределенных метода ? OnStartPage и OnEndPage. Также будет создан файл Test.asp, который содержит HTML документ с заготовками VB скриптов для тестирования сервера.
Если заглянуть в файл реализации (U1_01.pas) , то класс ТТest является потомком класса TASPObject. При выборе же опции Object Context библиотека типов не содержит предопределенных методов, а сам класс TTest являлся бы потомком TASPMTSObject. Оба класса-предка TTest содержат абсолютно одинаковые методы и свойста, но класс TASPObject дополнительно содержит пару методов интерфейса IASPObject - OnStartPage и OnEndPage.
Далее, создадим метод, который будет заполнять HTML документ. Для этого в редакторе библиотеки типов (рис 2) отметим интерфейс ITest и вызовем команду New Method нажатием кнопки 1:

Рис. 2. Добавление нового метода к редактору библиотеки типов ASP сервера.
Назовем вновь созданный метод ScriptContent набив этот текст в названии метода с мигающей кареткой. Данный метод не должен иметь параметров. Далее вызовем команду Refresh нажатием кнопки 2. После этого в модуле реализации (U1_01.pas) появится заготовка, где следует описать реализацию. Метод реализуем следующим образом:

procedure TTest.ScriptContent;
begin
  If Assigned(Response) Then Response.Write('First call to ASP server');
End;

в данном примере происходит обращение к методу Write интерфейса IResponse. Проверка Assigned(Response) гарантирует, что в момент записи сообщений имеется ссылка на интерфейс.
После этого следует модифицировать созданный Delphi HTML документ для тестирования сервера, который хранится в файле Test.asp. В этом документе имеется VB скрипт следующего содержания:

<% Set DelphiASPObj = Server.CreateObject("ASP01.Test")
DelphiASPObj.{Insert Method name here}
%>

Скрипт в данном виде работать не будет. Необходимо заменить фразу в фигурных скобках {Insert Method name here} на имя метода ASP сервера, который генерирует отклик. В данном примере это имя ScriptContent. Финальные исправления выглядят следующим образом:

<% Set DelphiASPObj = Server.CreateObject("ASP01.Test")
DelphiASPObj.ScriptContent
%>

Проект необходимо скомпилировать и далее можно приступить к его тестированию. Для этого необходимо создать виртуальную директорию на IIS, причем эта директория обязана иметь разрешение как на Read (из нее будут читаться данные), так и на Execute (из нее будет загружена и запущена ASP01.dll). Альтернатива ? разместить эти файлы в разных директориях, одна из которых имеет доступ Read, а вторая ? Execute. Но в любом случае выбранные директории должны экспонироваться через HTTP протокол. Поэтому в первую очередь необходимо обратиться к WWW сервису IIS, посмотретьсписок доступных директорий и при необходимости создать новые с соответствующими правами доступа. В данном конкретном примере на компьютере, который имеет IP адрес 10.10.10.65 была создана виртуальная директория /Test, которая соответствует физическому адресу на компьютере C:\ASPTest. Директория имеет доступ на Read и Execute и туда были скопированы оба файла. Далее в Microsoft Internet Explorer следует набрать команду в поле Address: HTTP://10.10.10.65/Test/Test.asp и результат выполнения этого запроса показан на рисунке 1. Видно, что скрипт ( текст между <% и %>) был замещен результатом выполнения метода ScriptContent в ASP сервере.
Рассмотрим теперь подробнее, каким образом выполняется скрипт в странице Test.asp. IIS, который получает запрос на Test.asp он считывает ее содержимое из хранилища, находит скрипт и выполняет ее. При этом в фоне запускается VB и вызывается команда CreateObject. Если ASP01.dll ранее не была загружена, то происходит ее загрузка. Для данного запроса создается COM обьект ? экземпляр класса TTest (он описан в модуля реализации, для данного примера - U1_01.pas). Ссылка на интерфейс IDispatch (он поддерживается в классе TTest) сохраняется в переменной DelphiASPObj. В дальнейшем написании кода после имени переменной, хранящей ссылку на IDispatch, можно набирать любой текст. Компилятор VB использует текст, который содержится в скрипте и следует после имени переменной (в данном примере: переменная ? DelphiASPObj, метод - .ScriptContent) для того, чтобы передать его ASP серверу. Если ASP сервер найдет метод с данным именем, то он его выполнит. При отсутствии метода с таким именем генерируется исключение. Поэтому при написании скриптов для ASP сервера следует быть внимательным в названиях методов и при наличии исключений в первую очередь проверить корректность имен методов. При вызове какого-либо метода ASP серверу становятся доступные интерфейсы IRequest и IResponse.
Теперь рассмотрим пример создания более сложного ASP сервера, где анализируется запрос клиента при помощи методов интерфейса IRequest. Задачу поставим следующим образом: дадим возможность клиенту найти по фрагменту имени поля ENAME таблицы EMP в базе данных ORCL (генерирует Oracle при установке) . Для этого в каком-либо редакторе форм создадим форму, содержащую однострочный редактор текста и кнопку Submit. HTML документ этой формы выглядит следующим образом:
<html>
<head>
<meta http-equiv="Content-Type"
content="text/html; charset=windows-1257">
<meta name="GENERATOR" content="Microsoft FrontPage Express 2.0">
<title>Untitled Normal Page</title>
</head>
<body bgcolor="#FFFFFF">
<form action="http://10.10.10.65/Test/Test.asp" method="POST"
name="Query">
<p>Name (fragment)<input type="text" size="20"
name="T1"></p>
<p><input type="submit" name="B1" value="Submit"></p>
</form>
</body>
</html>
При реализации этой формы вместо IP адреса 10.10.10.65 следует указать IP адрес компьютера, на котором установлен ASP сервер. Поместим этот документ в директорию C:\ASPTest, которая имеет доступ на Read и Execute (см. выше) под именем Name.htm. Но перед тем, как создавать модуль данных и обращаться к серверу базы данных необходимо выяснить, каким образом анализируется запрос клиента в ASP сервере.
Запрос клиента можно анализировать при помощи вызова методов интерфейса IRequest, ссылка на который находится в свойстве Request класса TASPObject ? предка класса, где реализуется ASP сервер. Интерфейс IRequest предоставляет три свойства ? QueryString, Form и Body в которых находятся ссылки на интерфейс IRequestDictionary. QueryString содержит параметры запроса, Form содержит список контролей, предоставляемых клиенту, а Body содержит данные, которые клиент ввел на контроли. Нам потребуются данные, поэтомк ниже будет анализироваться свойство Body, но все сказанное ниже о методах IRequestDisctionary применимо и к любому другому свойству типа ICustomDictionary ? QueryString, Form.
IRequestDictionary определен в модуле ASPTlb.pas следующим образом:

IRequestDictionary = interface(IDispatch)
  ['{D97A6DA0-A85F-11DF-83AE-00A0C90C2BD8}']
  function Get_Item(Var_: OleVariant): OleVariant; safecall;
  function Get__NewEnum: IUnknown; safecall;
  function Get_Count: SYSINT; safecall;
  function Get_Key(VarKey: OleVariant): OleVariant; safecall;
  property Item[Var_: OleVariant]: OleVariant read Get_Item; default;
  property _NewEnum: IUnknown read Get__NewEnum;
  property Count: SYSINT read Get_Count;
  property Key[VarKey: OleVariant]: OleVariant read Get_Key;
end;


Документация о свойствах этого интерфейса отсутствует и остается только догадываться, каким образом из него можно извлечь параметры запроса введенные пользователем. Привлекая документацию по компоненту TWebDispatcher, который используется при создании CGI приложений и ISAPI DLL, где также можно анализировать параметры запроса пользователя, можно догадаться что свойство Count содержит число контролей на форме - для формы сделанной выше в Name.htm оно равно 2 . Свойство Key ? имя контролей - для формы в Name.htm это имена T1 (текст) и B1 (кнопка). И, наконец, свойство Item содержит введенные пользователем значения. И все эти рассуждения правильные. Но реализовано все это настолько поразительно криво. Поскольку файл ASPTlb.pas представляет собой перевод соответствующего *.h C++ файла, распространяемым Microsoft, претензии по его реализации следует адресовать этой компании.
Свойство Count работает как положено ? возвращает двойку для примера выше. Но при попытке извлечь имя ключа обнаруживается неприятная особенность ? в коллекции Key[] индексы начинаются с единицы, а не с нуля, как это принято в подобного типа приложениях. Все же обращаясь к коллекции Key с соответствующим индексом ? 1 или 2 для примера выше можно получить названия контролей в виде строковых переменных. Аналогичная попытка извлечь данные, введенные пользователем в контроли, ни к чему хорошему ни приводят ? при попытке присвоить строковой переменной значения из коллекции Item[] (которая обьявлена аналогична коллекции Key[]) происходит исключение. Анализируя значение, возвращаемое коллекцией Item[I] можно обнаружить, что возвращается интерфейс - потомок IDispatch. Методы и свойства этого интерфейса не описаны. Отсутствие описания интерфейса а также возврат ссылки на него в переменной типа OLE variant, а не IDispatch характерно для продуктов, которые находятся в процессе разработки. При разработке заголовки методов интерфейса, список параметров методов и их число постоянно меняется и чтобы не происходили исключения в клиентных приложениях, часто используют позднее связывание. Этот факт настораживает ? не исключена возможность изменения методов интерфейса в будущем и это может привести к потере работоспособности созданных ранее ASP серверов. Но будем надеяться, что данный интерфейс устоялся и Microsoft вследствии занятости просто забыл внести изменения в интерфейсный модуль и дать его документацию.
Интерфейс - потомок IDispatch два свойства: Count, которое возвращает всегда 1 и Item[] ? коллекцию, которое возвращает текст, введенный клиентом в контроле. Коллекция Item начинается с индекса 1. Для понимания и тестирования запроса в ASP сервере сделаем небольшое дополнение к проекту. Воспользовавшись редактором библиотек типов создадим новый метод RequestProp, как это было описано ранее (Рис. 2). Напишем следующий код для метода RequestProp:

procedure TTest.RequestProp;
var
  S: string;
  V: OLeVariant;
  I, J, N: integer;
begin
  S := '';
  if Assigned(Request) then
    if Request.Body.Count > 0 then
      begin
        for I := 1 to Request.Body.Count do
          begin
            S := S + 'Key' + IntToStr(I) + '=' + Request.Body.Key[I] + '<BR>';
            V := Request.Body.Item[I];
            if not VarIsEmpty(V) then
              if varType(V) = varDispatch then
                begin
                  N := V.Count;
                  S := S + 'ItemCount' + IntToStr(I) + '=' + IntToStr(N) + '<BR>';
                  if N > 0 then
                    for J := 1 to N do
                      S := S + V.Item[J] + '<BR>';
                end;
          end;
      end;
  if Assigned(Response) then Response.Write(S);
end;

Скомпилируем проект и в созданном ранее файле Test.asp изменим VB скрипты следующим образом: вместо строки DelphiASPObj.ScriptContent напишем строку DelphiASPObj. RequestProp. После этого в Internet Explorer следует обратиться к Name.htm следующей командой: http://10.10.10.65/Test/Name.htm, где вместо 10.10.10.65 следует набрать IP адрес сервера. В полученной форме (рис. 3)


введем какое-либо значение в редакционный контроль и нажмем кнопку Submit. После этого получим результат выполнения приведенного выше кода метода RequestProp:

Key1=T1
ItemCount1=1
AM
Key2=B1
ItemCount2=1
Submit

То есть для определения параметров, введенных клиентом в какой-либо контроль, необходимо просмотреть все ключи, найти индекс интересуемого нас контроля (в данном примере он 1, что соответствует ключу T1) и извлечь значение, введенное клиентом, посредством вызова команды Request.Body.Item[Index].Item[1].
Теперь можно перейти к модификации имеющегося сервера - создание нового метода для доступа к базам данных. На него необходимо поместить невизуальные компоненты доступа к данным, визуальные компоненты нельзя использовать в ASP сервере. Вообще, в приложениях такого типа ? ASP, ISAPI/NSAPI, CGI показ модальных форм с контролями (а диалоги ? частный вид таких форм) ни к чему хорошему не приводит. При попытке показать диалог, контроли на диалоге будут созданы, на них будет помещен текст и\или картинки и приложение будет ожидать, когда диалог будет закрыт (нажатием кнопки OK или Cancel) чтобы продолжить свою работу. Особенность заключается в том, что диалог невидим. Поэтому его нельзя закрыть ни нажатием кнопок (они не получают сообщения OnClick) ни акселератором (сигналы с клавиатуры не посылаются невидимым контролям). Визуально программист наблюдает следующее ? приложение висит, отклик с ASP сервера клиент не получает и для повторной компиляции проекта требуется перезагрузка системы. Даже если команды показа диалогов отсутствуют в ASP сервере, они могут быть показаны в процессе работы приложения ? например, BDE пришлет сообщения об ошибке. Поэтому данный факт надо принимать во внимание при написании кода, где необходимо тщательно проверять данные перед их использованием, чтобы внешние приложения не сообщали об ошибках.
Традиционно доступ к данным очуществляется через BDE, при этом необходимо использовать компонеты TSession, TDatabase и TQuery. Однако, при обращении к данным в ASP сервере, выяснилось, что BDE нельзя использовать для доступа к SQL серверам. Исключение происходит при попытке соединиться с базой данных после передачи login параметров. Из серверов тестировались Oracle и Interbase. Через BDE удалось получить доступ только к DBDEMOS, которая не требует аутентификации пользователя при обращении к данным.
К счастью, в Delphi5 появилась альтернативный способ доступа данных ? через ADO (Active Data Objects). Для работы с ADO прежде всего необходимо использовать компонент TADOConnection. Поставим его на форму. В инспекторе обьектов выберем свойство ConnectionString и вызовем диалог для создания строки. В предложенном диалоге выберем Microsoft OLE DB Provider for Oracle и нажмем кнопку Next (рис. 4).



Рисунок 4. Установление параметров для ADO соединения с Oracle сервером.
На второй странице диалога необходимо указать имя сервера (в данном примере ? beq-local) и параметры аутентификации ? имя пользователя (SCOTT) и пароль (TIGER). Обязательно ставится метка в Allow Saving Password контроле ? иначе ASP сервер попытается показать Login диалог! Протестировать соединение можно нажатием кнопки Test Connection ? должно быть сообщение об успешном соединении с сервером.
Далее в инспекторе обьектов необходимо свойство LoginPromp в False. При работе с другими примерами необходимо также изменять свойство DefaultDatabase ? имя базы данных, но для данного примера это не обязательно. Проверить правильность установок можно при помощи изменения свойства Connected в True, при этом не должен появить Login диалог или информация об исключении.
Поставим компонент TADOQuery на модуль данных и в свойстве Connection сошлемся на определенный выше компонент ADOConnection1.
Модуль данных, на которые можно помещать невизуальные компоненты, не создается автоматически при вызове эксперта для создания ASP сервера,. Поэтому его необходимо создавать отдельно. Вызовем команду File/New/Data Module добавим модуль данных к проекту. Запомним вновь созданный файл под именем U1_02.pas. Следует учесть, что созданный модуль данных не будет создаваться автоматически при старте приложения или при обращении клиента. Поэтому необходимо переписать конструктор и деструктор класса TTest, реализация которого находится в файле U1_01.pas. Сошлемся на модуль U1_02.pas в модуле U1_01.pas. В обьявлении класса TTest в секции private определим переменную FData типа TDataModule1. В секции public обьявим процедуры AfterConstruction и BeforeDesctruction c обязательной директивой override:

TTest = class(TASPObject, ITest)
private
  FData: TDataModule1;
protected
  …
  public
  procedure AfterConstruction; override;
  procedure BeforeDestruction; override;
end;
реализуем процедуры AfterConstruction и BeforeDestruction в секции реализации:
procedure TTest.AfterConstruction;
begin
  inherited;
  FData := TDataModule1.Create(nil);
end;

procedure TTest.BeforeDestruction;
begin
  if Assigned(FData) then
    begin
      FData.Query1.Active := False;
      FData.ADOConnection1.Connected := False;
      FData.Free;
    end;
  inherited;
end;

Далее следует создать новый метод в библиотеке типов (рис. 2), назовем его QueryResponse. Реализуем его следующим образом:

procedure TTest.QueryResponse;
var
  S: string;
  I, J: integer;
begin
  S := Request.Body.Item[1].Item[1];
  if FData.ADOQuery1.Active then FData.ADOQuery1.Close;
  FData.ADOQuery1.SQL.Clear;
  FData.ADOQuery1.SQL.Add('Select * from EMP');
  FData.ADOQuery1.SQL.Add('where ENAME like ''%' + S + '%''');
  FData.ADOQuery1.Active := True;
  if FData.ADOQuery1.RecordCount > 0 then
    begin
      FData.ADOQuery1.First;
      for J := 0 to FData.ADOQuery1.Fields.Count - 1 do
        Response.Write(FData.ADOQuery1.Fields[J].FieldName + ' ');
      Response.Write('<BR>');
      for I := 1 to FData.ADOQuery1.RecordCount do
        begin
          for J := 0 to FData.ADOQuery1.Fields.Count - 1 do
            Response.Write(FData.ADOQuery1.Fields[J].AsString + ' ');
          Response.Write('<BR>');
          if I < FData.ADOQuery1.RecordCount then FData.ADOQuery1.Next;
        end;
    end;
end;

В этом методе динамически создается SQL запрос, при этом используются параметры, введенные клиентом в форму на рисунке 3. С этим запросом происходит обращение к SQL серверу и возвращаемые данные помещаются в HTML документ. В созданном ранее файле Test.asp изменим VB скрипты следующим образом: вместо строки DelphiASPObj.ScriptContent напишем строку DelphiASPObj. QueryResponse. После этого в Microsoft Internet Explorer обращаемя к странице Name.htm, как это показано на рисунке 6. Результат выполнения запроса приведен на рисунке 5:


Рисунок 5. Результат обращения ASP сервера к Oracle серверу.
При использовании ASP сервера можно поместить параметры, необходимые для его работы, в HTML документ. Эти параметры могут редактироваться в документе и, таким образом, можно изменять опции под конкретный сайт. Это является удобным при распространении ASP сервера: купившая его компания может изменить начальные установки так, что они отвечают требованиям компании. Для этого достаточно отредактировать HTML документ, что может быть сделано при использовании специалистов низкой квалификации. Пример проиллюстрируем следующим образом: определим в заговке класса TTest (U1_01.pas) две переменные: FCompanyName:string и FCopyrightYear:string; Определим в библиотеке типов (рис 2) два новых свойства: CompanyName:string и CopyrightYear:integer. На методы *Read и *Wirte для этих свойств определим чтение и возврат данных из описанных выше переменных. Добавим новый метод в библиотеку типов ShowCopyright, который реализуем следующим образом:

procedure TTest.ShowCopyright;
var
  S: OLEVariant;
begin
  S := Format('Copyright (C) %d by %s', [FCopyrightYear, FCompanyName]);
  if Assigned(Response) then Response.Write(S);
end;

В созданном ранее файле Test.asp изменим VB скрипты:

<% Set DelphiASPObj = Server.CreateObject("ASP01.Test")
DelphiASPObj.CompanyName = "My Company"
DelphiASPObj.CopyrightYear = 1999
DelphiASPObj.ShowCopyright
%>

Результатом обращения к ASP серверу при помощи команды: http://10.10.10.65/Test/Test.asp (вместо 10.10.10.65 следует выбрать IP адрес сервера) будет генерация следующей страницы (рис. 6):



Рисунок 6. Чтение и показ ресурсов в HTML документе Если в файле Test.asp изменить имя компании ? а это можно сделать при помощи любого текстового редактора, то все изменения будут отражаться в HTML документе. В заключении следует рассмотреть out-of-process ASP сервера. Эти сервера реализуются в *.exe приложениях и работают они в отдельном адресном пространстве. До сих пор рассматривались in-process сервера, которые работают в адресном пространстве IIS и реализуются в динамически загружаемых библиотеках ? DLL. Для их создания необходимо открыть готовый проект, компиляция которого приводит к созданию *.exe файла или создать новый проект посредством вызова команды File/New Application. После этого необходимо выполнить команду File/New/ActiveX/Active Server Object. Будет создана библиотека типов, содержащая методы OnStartPage и OnEndPage.Все, что было сказано выше для in-process сервера применимо и к out-of-process: делаются новые методы и из вызываются из VB скриптов *.asp страницы. Сложности возникают при попытке протестировать out-of-process сервер. По умолчанию параметры IIS установлены таким образом, что запрещают запуск приложений: разрешен запуск только DLL. Более того, в администраторе IIS отсутствует опция, которая позволяет разрешить или запретить использование приложения, как ASP сервера. Для того, чтобы разрешить запуск исполняемого файла, как ASP сервера, необходимо выполнить следующий VB скрипт: Set oWebService = GetObject("IIS://LocalHost/W3svc") oWebService.Put "AspAllowOutOfProcComponents", True oWebService.SetInfo Для того, чтобы он был выполнен, необходимо, чтобы текущий пользователь имел статус администратора. По этой причине данный скрипт бесполезно определять в HTML документе и запускать его, используя IE: любой пользователь интернета имеет статус гостя. Данный скрипт необходимо поместить в обработчик какого-либо события в среде разработке VB и запустить его оттуда. Я не сумел сделать аналог данного скрипта в Delphi: не найден метод, аналогичный методу VB GetObject. Очевидно, что метод GetObject возвращает ссылку на IDispatch IIS. Но при этом в качестве параметра он использует строку, которая не является классовой (GUID отсутствкует в системном реестре). В Delphi аналогичные методы отсутствуют, по крайней мере, в виде простых вспомогательных функций. Возможно данный метод станет доступным в следующих версиях Delphi.    

Взято с Исходников.ru

Создание Аккаунта в Windows, используя ADSI (Активные директории)

Создание Аккаунта в Windows, используя ADSI (Активные директории)

Автор: Philip Jespersen

Чтобы создавать пользовательские аккаунты в Windows на Delphi можно использовать ADSI (Active Directory Services Interface) от Microsoft. Вы думаете, что ADSI это новая примочка для Windows 2000 (судя по названию) , но оказывается ADSI доступна для всех платформ Win32. Для этого Вам потребуется всего навсего скачать ADSI для Windows (более полная информация на http://www.microsoft.com/adsi ). Ну и конечно же ADSI входит в поставку Windows 2000.

ADSI довольно большой предмет для изучения. В данном примере я затрону этот предмет поверхностно. ADSI - это своего рода основа для различных сервисов (обычно основанных на директориях) оперционной системы. Например, стандартными ADSI сервисами можно назвать (COM интерфейсы, которые можно использовать в программах) WinNT, IIS, LDAP и NDS. WinNT сервис может тем самым использоваться для создания пользовательских аккаунтов, модификации их или модификации групп.

Следующий небольшой пример показывает необходимые шаги для создания пользовательского аккаунта в NT/2000, используя ADSI:

Во первых Вам прийдётся импортировать Библиотеку Типов ADSI (Menu Project/Import Type Library). Библиотеку Типов можно найти в поддирректории system32 (Например C:\WINNT\system32\activeds.tlb). Требуемый файл называется 'activeds.tlb'. Если такого файла нет, то проверьте, правильно ли вы установили ADSI. После успешного импортирования Библиотеки Типов Вы найдёте новый файл в дирректории ипортов Delphi, файл будет называться "activeds_tlb.pas" (..\Delphi5\Imports\activeds_tlb.pas). Чтобы приступить к программированию ADSI в Delphi, необходимо включить этот файл в Ваш проект.

Далее в примере, необходимо заменить [computername] на фактическое имя компьютера, с которым Вы работаете. То же надо проделать с [accountname]. Пример тестировался на WindowsNT 4.0 и Windows 2000.

...

uses ActiveX,        // используется для COM Moniker stuff... 
     ActiveDs_TLB,   // созданная библиотека типов 
     ComObj;         // используется для OleCheck и других функций COM 

implementation 

procedure TForm1.BtnCreateUserClick(Sender: TObject); 
var 
  Usr:  IADsUser; 
  Comp: IADsContainer; 
begin 
  try 
    Comp := GetObject('WinNT://[computername],computer') as 
      IADsContainer; 
    Usr := Comp.Create('user', '[accountname]') as IADsUser; 
    Usr.SetInfo; 
  except 
    on E: EOleException do begin 
      ShowMessage(E.Message); 
    end; 
  end; 
end; 


procedure TForm1.BtnSetPasswordClick(Sender: TObject); 
var 
  Usr: IADsUser; 
begin 
  try 
    Usr := GetObject('WinNT://[computername]/[accountname],user') 
      as IADsUser; 
    Usr.SetPassword('thenewpassword'); 
  except 
    on E: EOleException do begin 
      ShowMessage(E.Message); 
    end; 
  end; 
end; 


// GetObject использует вызов VB GetObject 
// Данный код (GetObject) был найден в Usenet.   
// 
// GetObject позволяет связаться с существующим ADSI сервисом 
// используя 'ADSIPath' (например WinNT://.... или 
// IIS://localhost). 

function TForm1.GetObject(const Name: string): IDispatch; 
var 
  Moniker: IMoniker; 
  Eaten: integer; 
  BindContext: IBindCtx; 
  Dispatch: IDispatch; 
begin 
  OleCheck(CreateBindCtx(0, BindContext)); 
  OleCheck(MkParseDisplayName(BindContext, 
                              PWideChar(WideString(Name)), 
                              Eaten, 
                              Moniker)); 
  OleCheck(Moniker.BindToObject(BindContext, NIL, IDispatch, 
            Dispatch)); 

  Result := Dispatch; 
end; 

end. 


Через ADSI Вы так же можете изменять параметры пользовательских аккаунтов. Следующий код изменяет флаг 'Password never expires' нужного аккаунта:

procedure TFormMain.ButtonNeverExpiresClick(Sender: TObject); 
var 
  Usr: IADsUser; 
begin 
  try 
    Usr := GetObject('WinNT://[computername]/[acccoutname],user') as 
      IADsUser; 

  // Проверяем состояние чекбоксов... 
  if CheckBoxPasswordNeverExpires.Checked then 
    Usr.Put('UserFlags', Usr.Get('UserFlags') OR 65536) 
    // 65536 объявлено как UF_DONT_EXPIRE_PASSWORD в iads.h   
    // в ADSI SDK от Microsoft 
  else 
    Usr.Put('UserFlags', Usr.Get('UserFlags') XOR 65536);   
    Usr.SetInfo; 

  except 
    on E: EOleException do begin 
      ShowMessage(E.Message); 
    end; 
  end; 
end; 


В завершении...

Чтобы использовать большие возможности ADSI , необходимо проверить, поддерживаются ли такие сервисы как IADsUser или IADsContainer.
Я рекомендую поработать с ADSI SDK от Microsoft и более детально изучить Библиотеку Типов.

Некоторые ADSI компоненты я постараюсь выложить на своей домашней страничке (http://www.jespersen.ch). Так что, если интересно, то заходите и мыльте на philip@jespersen.ch

Взято с Исходников.ru

Создание базы данных

Создание базы данных

Итак, Как создать базу данных?

Пока мы рассматриваем Paradox осмелюсь заметить, что база данных ничто иное как папка (каталог) на диске. Надеюсь что читателю не составит труда создать пустой каталог, например "c:\MyDBExample". Теперь создадим Alias на этот каталог:

1) Открываем BDE Administrator, нажимаем menu->Object->New (или Ctrl-N)
2) В выскочившем окне выбираем Standard, жмём Ok
3) На левой панеле переименовываем название Alias во что-нибудь, например "MyDB"
4) На правой панеле, в разделе PATH указываем c:\MyDBExample
5) Сохраняем изменения

Закрываем BDE Administrator. Загружаем Дельфи с нашим примером, убеждаемся, что в свойстве DatabaseName у таблицы появился среди вариантов выбора и наш Alias - "MyDB".

А как создать базу данных программно? Забегаю вперёд, новички могут со спокойной совестью эту информацию пропустить.

С созданием базы данных програмно большие проблемы! Задача состоит из 2х этапов:

1) Создание самой базы данных
2) Создание Alias

Второй вопрос весьма прост - используются методы системного объекта Session:
session.AddAlias
Session.SaveConfigFile

Ответ же на первый не однозначен и вызвано это тем, что это целиком зависит от базы данных. Так как Dbase и Paradox базы данных это просто каталоги, то тут проблем нет, создаём каталог (ForceDirectories например) и дело с концом, для MS Access и MS Excel уже прийдётся использовать DAO низкоуровневые функции, серверные базы данных обычно имеют системные Stored Procedures для создания базы данных.

Создание CGI приложений

Создание CGI приложений

Cодержание раздела:





·  
·  
·  
·  
·  
·  
·  

Создание CGI счётчика в Delphi 5

Создание CGI счётчика в Delphi 5

(Перевод одноимённой статьи с сайта http://homepages.borland.com/aohlsson/Articles/CounterCGI.html)
Если Вы программируете в Delphi и, хотели бы, чтобы Ваш любимый компилятор поучавствовал в создании Вашей веб-странички, то можно начать с маленькой, но довольно важной части веб-проекта - счётчика. Обычно, счётчик выглядит как кнопка на странице. В данном случае это JPEG картинка, генерируемая на лету.
Те, кто желает сразу приступить к компиляции, могут скачать исходник и, в случае возникновения каких либо вопросов, вернуться к данной статье.


Вызывается счётчик тэгом IMG примерно так:
<img src="http://ww5.borland.com/scripts/CounterCGI.exe?FileName=Article">  
CGI скрипт так же может получать определённый набор параметров:
Txt e.g. "You are visitor %d today, and %d ever."
FontName e.g. "Courier"
FontColor e.g. "clGreen" or "$404040"
BackgroundColor e.g. "clYellow" or "$808080"
А вот так выглядит вызов скрипта с несколькими параметрами:
http://ww5.borland.com/scripts/CounterCGI.exe?FileName=Article&BackgroundColor=$808080&FontColor=$404040&FontName=Courier  
Итак, давайте разбираться с кодом.
Начать создавать новое CGI приложение следует с выбора File | New | Web Server Application | CGI stand-alone executable. После этого Вы получите чистый Web модуль. Добавьте новый TWebActionItem в подсвеченном свойстве действий (Actions) в TWebModule, нажав на Add Item. Затем двойным щелчком на событие OnAction создайте обработчик действия.
Изображение JPEG, получается как снимок изображения с TPanel, с TMemo внитри него. Таким способом легче придать 3D вид счётчику. Для начала нам необходимо добавить следующую строку в раздел implementation:
     implementation

     uses
       ExtCtrls, StdCtrls, Controls, Forms, Graphics, JPEG;
Теперь, мы определим некоторые основные процедуры, которые будут использоваться в коде. GetPaths будет обеспечивать нас двумя жизненно важными путями. Первый путь будет указывать где хранится сам скрипт по отношению к корневой директории web сервера (т.е. относительный путь). Скорее всего это будет "scripts" или "cgi-bin" в зависимости от того, куда Вы его положите. Второй - это локальный путь в Windows. Он может выглядеть как "C:\InetPub". Для нас важны оба пути, чтобы обеспечить переносимость CGI скрипта из директории в директорию и с одного сервера на другой.

     procedure GetPaths(Request: TWebRequest; var ScriptPath, LocalPath : String);
     var
       ScriptFileName : String;
     begin
       ScriptPath := Request.ScriptName;
       ScriptFileName := ExtractFileName(ParamStr(0));
       // Убираем EXE/DLL имя, чтобы получить путь
       Delete(ScriptPath,Pos(ScriptFileName,ScriptPath)-1,Length(ScriptFileName)+1);
       // Убираем главную косую
       Delete(ScriptPath,1,1);

       LocalPath := ExtractFilePath(ParamStr(0));
       // Удаление ScriptPath даёт нам корневой путь
       Delete(LocalPath,Pos(ScriptPath,LocalPath)-1,Length(ScriptPath)+1);
     end;

Процедура SetVariable будет использоваться для инициализации нужных нам переменных.

     procedure SetVariable(var S : String; const Value, Default : String);
     begin
       S := Value;
       if S = '' then
         S := Default;
     end;

Вся суть CGI скрипта заключается в событие OnAction. Давайте рассмотрим его по шагам.
procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
Сперва объявим некоторые локальные переменные.

     var
       ScriptPath,
       LocalPath,
       FileName,
       Txt, FontColor,
       BackgroundColor,
       FontName,
       FontSize        : String;
       Today, LastEver,
       Ever, LastToday : Integer;
       LastDate        : TDate;
       MS              : TMemoryStream;
       Panel           : TPanel;
       Memo            : TMemo;
       Bitmap          : TBitmap;
       Form            : TForm;
       fp              : TextFile;

Теперь вызовем GetPaths, чтобы выяснить путь к скрипту, а так же локальный путь. В данном примере мы будем помещать наши счётчики в директорию "counters". Физический путь будет выглядеть примерно так "C:\InetPub\counters".

     begin
       GetPaths(Request,ScriptPath,LocalPath);
       LocalPath := LocalPath+'counters\';

Затем, мы получаем все параметры, переданные вместе с вызовом скрипта. Параметры поступают к нам через свойство Request.QueryFields. Обратите внимание, что если какой-то параметр не был передан, то SetVariable устанавливает его по умолчанию.

       with Request.QueryFields do begin
         FileName := LocalPath+Values['FileName']+'.txt';
         SetVariable(Txt,Values['Txt'],'You are visitor %d today, and %d ever.');
         SetVariable(FontName,Values['FontName'],'Arial');
         SetVariable(FontSize,Values['FontSize'],'10');
         SetVariable(FontColor,Values['FontColor'],'clWhite');
         SetVariable(BackgroundColor,Values['BackgroundColor'],'clBlack');
       end;

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

       try
         // Write a new empty counter file if it doesn't exist
         if not FileExists(FileName) then begin
           AssignFile(fp,FileName);
           Rewrite(fp);
           WriteLn(fp,0);
           WriteLn(fp,Date);
           WriteLn(fp,0);
           CloseFile(fp);
         end;

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

         // Читаем старые значения счётчика
         AssignFile(fp,FileName);
         Reset(fp);
         ReadLn(fp,LastEver);
         Ever := LastEver+1;
         ReadLn(fp,LastDate);
         ReadLn(fp,LastToday);
         if Date = LastDate then
           Today := LastToday+1
         else
           Today := 1;
         CloseFile(fp);

И в заключении, надо записать новые значения в файл, содержащий данные счётчика.

         // Записываем новые значения счётчика
         AssignFile(fp,FileName);
         Rewrite(fp);
         WriteLn(fp,Ever);
         WriteLn(fp,Date);
         WriteLn(fp,Today);
         CloseFile(fp);

Теперь приступим к созднию того, что в конечном итоге будет называться JPEG. Для начала сделаем невидимым TForm которая содержит TPanel и TMemo. Так же устанавливаем FontName и FontSize.

         Form := TForm.Create(nil);
         with Form.Font do begin
           Name := FontName;
           Size := StrToInt(FontSize);
         end;

Удостоверимся в том, что текст, который мы помещаем в memo контрол, содержит значения счётчика, считанные из файла.

         Txt := Format(Txt,[Today,Ever]);

Далее мы создаём панель. Ширина и высота будут определяться шириной текста, который мы помещаем в неё. Так же устанавливаем скашивание для 3D эффекта.

         Panel := TPanel.Create(nil);
         with Panel do begin
           BevelInner := bvRaised;
           BevelOuter := bvLowered;
           Parent := Form;
           Width := Form.Canvas.TextWidth(Txt)+9;
           Height := Form.Canvas.TextHeight(Txt)+9;
         end;

Помещаем memo в панель, и устанавливаем её ширину и высоту, а так же цвет, который указан в BackgroundColor.

         Memo := TMemo.Create(nil);
         with Memo do begin
           Top := 2;
           Left := 2;
           Width := Panel.Width-5;
           Height := Panel.Height-5;
           Alignment := taCenter;
           Color := StringToColor(BackgroundColor);
           BorderStyle := bsNone;
           Parent := Panel;
         end;

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

         Bitmap := TBitmap.Create;
         with Bitmap do begin
           Width := Panel.Width-1;
           Height := Panel.Height-1;
           Canvas.Lock;
           Panel.PaintTo(Canvas.Handle,0,0);
           Canvas.Unlock;
           Canvas.Brush.Style := bsClear;
           with Canvas.Font do begin
             Name := FontName;
             Size := StrToInt(FontSize);
             Color := StringToColor(FontColor);
           end;
           Canvas.TextOut(4,3,Txt);
         end;

Затем преобразовываем bitmap в JPEG. JPEG будет записан в memory stream. Этот поток будет связан с браузером и передаваться посетителю странички в виде картинки.

         with Response do begin
           MS := TMemoryStream.Create;
           with TJPEGImage.Create do begin
             CompressionQuality := 75;
             Assign(Bitmap);
             SaveToStream(MS);
             Free;
           end;
           ContentType := 'image/jpeg';
           MS.Position := 0;
           SendResponse;
           SendStream(MS);
         end;

Освобождаем ресурсы.

         Panel.Free;
         Bitmap.Free;
         Form.Free;

На всякий случай обрабатываем исключительные ситуации.

       except
         on E: Exception do
           Response.Content := E.Message;
       end;
       Handled := True;
     end;

Вот собственно и всё. Наслаждайтесь счётчиком, сделанным в Delphi 5 :)

Создание COM-объектов средствами Delphi

Создание COM-объектов средствами Delphi

Часть 1
Как преодолеть отсутствие множественного наследования в Delphi.

Все сообщество программистов разделяется по приверженности к той или иной платформе и языку программирования. Один предпочитает Delphi для Windows, другому нравится ассемблер для DOS, третий программирует на Си++ для OS/2. Навыки работы для одной платформы совсем не обязательно станут полезными при переходе на другую, а знание отдельного языка программирования может даже затруднить изучение другого. Все эти преграды можно было бы преодолеть, используя межпроцессное взаимодействие между программами, однако здесь возникает новая трудность - разные формы внутреннего представления данных в этих программах.

Однако есть способ решения этих проблем: применение единого стандарта для организации связи между объектами, который не зависит от используемой платформы и языка. Именно такова разработанная Microsoft компонентная модель объекта COM (Component Object Model). Данная технология уже получила широкое внедрение: ведь на ее базе работают механизмы OLE и ActiveX.

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

В этой и следующей за ней статьях мы рассмотрим процесс формирования COM-объектов в среде разработки Borland Delphi. В первой части мы коснемся проблем организации COM-объектов в Delphi и покажем несколько вариантов их решения. Во второй части будут приведены примеры пяти типовых объектов для стандартных надстроек оболочки Windows 95. В отдельных случаях COM-объекты целесообразно хранить как EXE-файлы. Однако в этой статье с целью простоты изложения материала будут рассматриваться лишь COM-объекты, записанные в наиболее часто используемой для них форме DLL-модулей.

Основные понятия о COM-объектах
Что же кроется внутри COM-объекта? Нам совершенно не нужно вникать в это! Весь обмен информацией между COM-объектом и внешним миром осуществляется через конкретные интерфейсы. Каждый из них реализует доступ к одной или нескольким функциям, обратиться к которым может любой объект или программа. Все COM-объекты должны иметь интерфейс IUnknown с тремя его функциями - AddRef, Release и QueryInterface. Функции AddRef и Release отвечают за обычную задачу сопровождения жизненного цикла объекта. При каждом обращении к Addref содержимое счетчика ссылок данного объекта увеличивается на единицу, а при каждом обращении к Release - уменьшается. Когда значение счетчика достигает нуля, объект уничтожается. Практический интерес представляет третья функция интерфейса IUnknown - QueryInterface. Получив доступ к обязательно присутствующему интерфейсу IUnknown, программа или любой другой объект сразу может обратиться к функции QueryInterface и узнать обо всех остальных имеющихся у этого объекта интерфейсах. IUnknown находится на вершине иерархического дерева всех COM-интерфейсов. Любой другой интерфейс фактически наследуется от IUnknown и поэтому также должен обеспечивать доступ ко всем трем IUnknown-функциям.

Понятие объекта как в терминологии COM-модели, так и в Delphi или Си++ имеет практически одинаковый смысл. А вот COM-интерфейс больше напоминает Delphi- или Си++-объект, у которого отсутствуют public-переменные и имеются лишь виртуальные методы. Список функций интерфейса соответствует виртуальной таблице методов Object Pascal или объекта Си++. Создать COM-интерфейс можно средствами практически любого языка: достаточно лишь объявить объект с требуемым списком виртуальных методов. Само собой разумеется, что задаваемые определения методов должны в точности соответствовать определениям функций в самих интерфейсах. Однако, кроме того, необходимо соблюдать правильный порядок их размещения в виртуальной таблице. Сказанное означает, что эти определения следуют в заданном порядке, а перед ними нет никаких других виртуальных методов.

В файле OLE2.PAS, входящем в комплект Delphi 2.0, показано, как давать определение типу интерфейсного объекта для IUnknown и для нескольких десятков других, производных от IUnknown интерфейсов, например IClassFactory, IMarshal и IMalloc. Каждому методу, входящему в состав этих интерфейсных объектов, дается такое определение, как virtual, stdcall или abstract. Пояснение, зачем указывается virtual, уже было дано. Ключевое слово stdcall сообщает компилятору, что вызов данного метода следует производить по стандартным правилам. Слово abstract указывает, что функциональная часть данного метода в текущем объекте отсутствует, но она должна присутствовать у некоторого дочернего объекта, для которого будет создаваться его экземпляр. В файле OLE2.PAS дается определение для более чем 50 интерфейсов, непосредственно наследуемых от IUnknown, причем каждый из них предоставляет как собственный интерфейс, так и IUnknown.

Однако из-за необходимости иметь для COM-объекта два или более интерфейса, не считая IUnknown, возникает одна проблема. В Си++ достаточно дать определение COM-объекту как многократно наследуемому от тех объектов, где требуемые интерфейсы содержатся. Однако для объектов Delphi возможность множественного наследования не допускается. Поэтому приходится искать иное решение. (К сведению программистов на Си++: при создании COM-объектов на базе MFC применяется технология, аналогичная описываемой здесь для Delphi. Эта особенность остается незамеченной на фоне великого множества макроконструкций, которые используются при определении COM-объекта средствами MFC.)

Сателлиты и контейнеры
Ключевой фактор создания в Delphi COM-объекта с несколькими интерфейсами состоит в том, что объект рассматривается как передающий контейнер этих интерфейсов. Совсем не обязательно иметь их внутри данного COM-объекта. Необходимо лишь при запросе, когда вызывается метод QueryInterface его интерфейса IUnknown предоставлять доступ к нужному интерфейсу. Такой COM-объект, созданный в Delphi, может лишь непосредственно обслуживать три свои функции IUnknown, а при запросе через QueryInterface интерфейса IUnknown, передавать указатель на самого себя. Он действует как передаточный механизм и распорядитель других объектов, имеющих свои интерфейсы. Такие интерфейсные объекты-сателлиты отображают свои три IUnknown-метода на общий объект-контейнер. Если приходит запрос на один из сателлитных интерфейсов (как правило, через метод QueryInterface), контейнер передает указатель на соответствующий объект-сателлит. На листинге показан пример, как средствами Delphi можно создать такие интерфейсные объекты с типами сателлит и контейнер, а также как подготовить соответствующий интерфейс IClassFactory.

Листинг. С помощью этих обобщенных объектов с описанием интерфейсов можно создавать в среде Delphi COM-объекты с несколькими интерфейсами.


unit DelphCom;
// "Обобщенные" объекты. Предназначены для создания COM-объектов
// в Delphi. ISatelliteUnknown - интерфейсный объект, который
// будет обслуживаться через IContainerUnknown. Любой реальный
// COM-объект с несколькими интерфейсами
// будет наследоваться из IContainerUnknown и содержать
// функцию QueryInterface.
interface
uses Windows, Ole2, Classes, SysUtils, ShellApi, ShlObj;

var DllRefCount : Integer;
type
  IContainerUnknown = class;

ISattelliteUnknown = class(IUnknown)
  // Этот интерфейс будет обслуживаться через IContainerUnknown.
// Отображает три IUnknown-функции на свой объект-контейнер.
protected
  fContainer : IContainerUnknown;
public
  constructor Create(vContainer : IContainerUnknown);
  function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
  function AddRef: Longint; override;
  function Release: Longint; override;
end;

IContainerUnknown = class (IUnknown)
protected
  FRefCount : Integer;
public
  сonstructor Create;
  destructor Destroy; override;
  (IUnknown-функции)
  function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
  function AddRef: LongInt; override;
  function Release: LongInt; override;
end;

IMyClassFactory = сlass(IClassFactory)
private
  FRefcount : Integer;
public
  constructor Create;
  destructor Destroy; override;
  function QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult; override;
  function AddRef: LongInt; override;
  function Release: LongInt; override;
// В дочернем объекте должно быть дано определение
// для функции CreateInstance
  function LockServer(fLock: BOOL):
      HResult; override;
end;

function DLLCanUnloadNow : HResult; StdCall; Export;
implementation

(****** ISatelliteUnknown *****)
constructor ISatelliteUnknown.Create(vContainer:
    IContainerUnknown);
begin fContainer := vContainer; end;

function ISatelliteUnknown.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
begin
  Result := fContainer.QueryInterface(WantIid,
      ReturnedObject);
end;

function ISatelliteUnknown.AddRef: LongInt;
begin Result := fContainer.AddRef; end;

function ISatelliteUnknown.Release: LongInt;
begin Result := fContainer.Release; end;

(****** IContainerUnknown ******)
constructor  IContainerUnknown.Create;
begin
  inherited Create;
  FRefCount := 0;
  Inc(DllRefCount);
end;

destructor IContainerUnknown.Destroy;
begin
  Dec(DllRefCount);
  inherited Destroy;
end;

function IContainerUnknown.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
var P : IUnknown;
begin
  if IsEqualIID(WantIID, IID_IUnknown) then P := Self
  else P:= nil;
  Pointer(ReturnedObject) := P;
  if P = nil then Result := E_NOINTERFACE
  else begin
      P.AddRef;
      Result := S_OK;
  end;
end;

function IContainerUnknown.AddRef: LongInt;
begin Inc(FRefCount); Result := FRefCount; end;

function IContainerUnknown.Release: LongInt;
begin
  Dec(FRefCount);
  Result := FRefCount;
  if FRefCount = 0 then Free;
end;

(****** IMyClassFactory ******)
constructor IMyClassFactory.Create;
begin
  inherited Create;
  Inc(DllRefCount);
  FRefCount := 0;
end;

destructor IMyClassFactory.Destroy;
begin
  Dec(DllRefCount);
  inherited Destroy;
end;

function IMyClassFactory.QueryInterface(const WantIID: TIID;
    var ReturnedObject): HResult;
begin
  if IsEqualIID(WantIiD, IID_IUnknown) or
      IsEqualIID(WantIiD, IID_IClassFactory) then
  begin
      Pointer(ReturnedObject) := Self;
      AddRef;
      Result := S_OK;
  end
  else begin
      Pointer(ReturnedObject) := NIL;
      Result := E_NOINTERFACE;
  end
end;

function IMyClassFactory.AddRef: LongInt;
begin
  Inc(FRefCount);
  Result := FRefCount;
end;

function IMyClassFactory.Release: LongInt;
begin
  Dec(FRefCount);
  Result := FRefCount;
  if FRefCount = 0 then Free;
end;

function IMyClassFactory.LockServer(fLock: Bool):HResult;
begin Result := E_NOTIMPL; end;

(****** экспортируемая функция ******)
function DLLCanUnloadNow: hResult; StdCall; Export;
begin
  if DllRefCount = 0 then Result := S_OK
  else Result := S_FALSE;
end;

initialization
  DllRefCount := 0;
end.


Объекты-сателлиты
Объектный тип ISatelliteUnknown непосредственно наследуется от рабочего типа IUnknown, причем все его три абстрактных метода обязательно переопределяются. ISatelliteUnknown содержит единственное поле protected-переменной с именем FContainer и типом IContainerUnknown (его определение дается позже); начальное значение для данной переменной присваивается в его конструкторе Create. Назначение трех его IUnknown-функций состоит лишь в том, чтобы передать результат, полученный после вызова соответствующего метода объекта-контейнера. В зависимости от того, какой интерфейс запрашивает вызывающая программа, она получает доступ к методам QueryInterface, AddRef и Release либо непосредственно через объект-контейнер, либо через любой из его объектов-сателлитов

Если вам уже приходилось изучать литературу по технологии OLE, то вы наверняка обратили внимание, что в модуле DelphCOM, приведенном в листинге, используются нестандартные имена для параметров QueryInterface. Обычно для обозначения идентификатора ID нужного интерфейса используется имя riid, а передаваемому программе объекту назначается имя ppv. Поскольку имена параметров имеют смысл только в пределах данного объекта, я решил заменить зашифрованные стандартные имена на более понятные WantIID и ReturnedObject.

Объекты-контейнеры
Объектный тип IContainerUnknown также непосредственно наследуется от IUnknown. Он содержит собственный счетчик количества ссылок, записываемый в поле protected-переменной с именем FRefCount; его функция AddRef обеспечивает приращение счетчика FRefCount, а Release - его уменьшение. Обе функции - AddRef и Release - передают в программу новое значение счетчика. Если оно становится равным 0, функция Release дополнительно производит высвобождение объекта.

Кроме этого, в модуле DelphCOM дается определение глобальному счетчику ссылок для всей DLL, через который отслеживаются все объекты, производные от этих обобщенных COM-объектов. Его приращение и уменьшение производятся при работе соответственно конструктора и деструктора этого объекта-контейнера. Любая DLL, где содержатся COM-объекты, должна выполнять две специальные функции - DLLCanUnloadNow и DLLGetClassObject. В модуле DelphCOM присутствует функция DLLCanUnloadNow, которая будет принимать значение False до тех пор, пока значение упомянутого глобального счетчика DLL не станет равным 0. Что же касается функции DLLGetClassObject, то ее содержание специфично для каждой конкретной DLL, использующей DelphCOM. Поэтому ее нельзя будет записать до тех пор, пока не будут заданы сами COM-объекты (являющиеся производными от ISatelliteUnknown и IContainerUnknown).

Объект IContainerUnknown реагирует на запросы интерфейса IUnknown, поступающие через QueryInterface, и передает указатель на самого себя. При запросе иного интерфейса передается код ошибки E_NOINTERFACE. Когда же данная ситуация возникает в производном от IContainerUnknown объекте, то функция QueryInterface сначала обращается к этой, наследуемой от родительского объекта функции. Если в ответ передается значение E_NOINTERFACE, тогда проверяется совпадение идентификатора запрашиваемого интерфейса с идентификаторами его других интерфейсов. При совпадении в программу передается указатель этого объекта-сателлита.

Генератор класса
COM-объекты могут создаваться при выдаче соответствующей команды от системы или от некоторой программы. Этот процесс создания управляется особым типом COM-объекта, именуемым генератором класса (class factory); он также получается прямым наследованием от IUnknown. Имеющийся в модуле DelphCOM объект IMyClassFactory, как и объект IContainerUnknown, содержит методы AddRef и Release. Если через QueryInterface поступает запрос на IUnknown или IClassFactory, то он передает указатель на самого себя. Кроме названных трех функций в интерфейсе IClassFactory дополнительно появляются две новые - CreateInstance и LockServer. Обычно функция LockServer не требуется, и в этом случае она принимает особое значение E_NOTIMPL - признак того, что данная функция не задействована.

Наиболее важная функция генератора класса, ради которой он создается, - это CreateInstance. С ее помощью вызывающая программа создает экземпляр требуемого объекта. В модуле DelphCOM, правда, еще нет каких-либо "законченных" объектов; здесь содержатся лишь обобщенные объекты сателлита и контейнера. Когда мы даем определение COM-объекту как наследуемому от IContainerUnknown, нам также приходится давать определение объекту, производному от IMyClassFactory, функция которого - CreateInstance - будет передавать в программу новый экземпляр этого COM-объекта.

Теперь, введя IMyClassFactory, мы получили полный комплект обобщенного COM-объекта для работы в Delphi. Эта система из объектов сателлита и контейнера может использоваться в любом объектно-ориентированном языке программирования; ведь, действительно, COM-объекты, создаваемые средствами MFC, используют аналогичную систему. Во второй части этой статьи мы перейдем от теории к практике. Возможности рассмотренных здесь обобщенных объектов будут существенно расширены, что позволит в качестве примера создать пять различных типовых надстроек для оболочки Windows 95 - для обслуживания операций с контекстным меню, диалоговым окном Property, перетаскивания объектов с помощью правой клавиши мыши, манипуляций с пиктограммами и операций копирования.

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

Идентификаторы GUID, CLSID и IID
При создании и работе COM-объектов интенсивно используются идентификаторы, именуемые как Globally Unique Identifiers (глобально уникальные идентификаторы), или, коротко, GUIDs (произносится "GOO-ids"). Этот параметр представляет собой некоторое 128-разрядное число, генерируемое функцией CoCreateGUID, входящей в состав Windows API. Значения GUID должны быть уникальны в глобальных масштабах: передаваемое функцией CoCreateGUID значение никогда не должно повторяться. Крейг Брокшмидт (Kraig Brockschmidt), специалист по OLE (из группы разработчиков OLE в Microsoft), как-то заявил, что вероятность совпадения результатов двух различных обращений к CoCreateGUID равняется тому, что "два случайно блуждающих по вселенной атома вдруг внезапно столкнутся и образуют гибрид маленького калифорнийского авокадо с канализационной крысой из Нью-Йорка".

Дело в том, что у каждого интерфейса должен быть свой идентификатор IID (Interface ID), являющийся тем же самым GUID. В файле OLE2.PAS, входящем в комплект Delphi, дается определение десяткам таких параметров. Пример программы из данной статьи содержит ссылки на идентификаторы интерфейсов IUnknown и IClassFactory; а в файле OLE2.PAS содержится множество других подобных параметров. Кроме того, любой объектный класс, зарегистрированный в системе, должен иметь свой идентификатор класса Class ID (CLSID). Если вам когда-нибудь приходилось с помощью программы RegEdit просматривать ключ HKEY_CLASSES_ROOT\CLSID системного реестра Windows, вы наверняка обращали внимание на десятки, а иногда и сотни непонятных строк с записанными в них цифрами. Все это - идентификаторы классов для всех COM-объектов, зарегистрированных на вашем компьютере. Не будем вдаваться в подробности; скажем лишь, что при программировании COM-объектов следует использовать имеющиеся параметры GUID, а также создавать новые, специфичные для вашей конкретной программы.

Существует ряд бесплатных утилит, например UUIDGEN.EXE, позволяющих генерировать новые значения GUID. Однако после ее исполнения придется заниматься рутинной задачей - аккуратно переписывать полученные значения на место констант Delphi. Взамен UUIDGEN.EXE служба PC Magazine Online предлагает другую "консольную" программу с текстовым выводом. Ее можно либо загрузить в интегрированную среду Delphi и произвести компиляцию там, либо обработать компилятором Delphi, введя через командную строку DCC32 GUIDS.DPR. Теперь запустите полученную программу, и вы получите абсолютно новое, не встречавшееся ранее значение GUID - в виде строки и в виде типовой константы Delphi.

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

© Нил Дж. Рубенкинг
Материал взят с PC Magazine, January 7, 1997, p. 227

Часть 2
Примеры создания четырех COM объектов - расширений оболочки Windows 95.

В технологиях создания COM объектов в среде Delphi и в среде Си++ наблюдаются существенные различия, хотя, конечно, есть в них и некоторое сходство: у таких объектов обычно один или несколько интерфейсов, а у объекта в Delphi и у объекта в C++ может быть один и тот же COM-интерфейс. Однако в Си++ задача обеспечения COM объекта несколькими интерфейсами решается с помощью механизма множественного наследования, т. е. порождаемый объект наследует функции от всех требующихся интерфейсов. В Delphi подобной возможности нет, поэтому необходим другой подход.

В Delphi COM объект с несколькими интерфейсами приходится формировать из нескольких отдельных объектов. Каждый из требующихся COM-интерфейсов предоставляется объектом-сателлитом - потомком имеющегося в Delphi объекта типа IUnknown. Такой объект-саттелит реализует интерфейс IUnknown. Сам же COM объект представляет собой объект-контейнер, тоже производный от IUnknown. Объект-контейнер, содержащий экземпляры объектов-сателлитов в виде полей данных, в ответ на запрос к своему методу QueryInterface передает указатель на упомянутый в нем интерфейс. Эти приемы и их реализацию на примере объектов ISatelliteUnknown и IContainerUnknown мы рассмотрели в первой части данной статьи. А теперь с помощью этих объектов мы попробуем подготовить специальные COM объекты - расширения оболочки Windows 95.

Мы продемонстрируем процедуры создания средствами Delphi четырех расширений Windows95: обработчика контекстного меню, обработчика списка параметров, обработчика для механизма drag-and-drop и обработчика пиктограмм. Они выполняют операции с некоторым воображаемым типом файлов DelShellFile с расширением DEL. Строка текста такого файла представляет собой целое число; в настоящей программе его заменит какой-то более сложный атрибут файла. Названный "магический номер" используется всеми четырьмя расширениями.

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

Все упомянутые в статье программы можно загрузить из службы PC Magazine Online.

Подготовка вспомогательных интерфейсов
На рис. 1 представлена иерархия создаваемых нами вспомогательных объектов. Сплошными линиями обозначены стандартные иерархические связи между объектами; на вершине этого дерева вы видите объект IUnknown, описанный на языке Delphi. Под именем каждого объекта перечисляются все его интерфейсы, за исключением обязательного для всех интерфейса IUnknown. Пунктирными линиями показаны связи контейнер/сателлит, которые служат основой всей системы.

Инициализаций расширений, предназначенных для обслуживания контекстного меню, списка параметров и работы механизма drag-and-drop, выполняется с помощью интерфейса IShellExtInit. Аналогичная операция для расширения - обработка пиктограмм осуществляется через интерфейс IPersistFile. На лист. 2 приведены описания объектов-сателлитов, реализующих два названных вспомогательных интерфейса, и объектов-контейнеров, заранее подготовленных для управления этими объектами-сателлитами.

Дополнительный метод Initialize объекта IMyShellExtInit служит функцией Initialize интерфейса IShellExtInit. Данный объект наследует функции объекта ISatelliteUnknown: его методы QueryInterface, AddRef и Release. В результате таблица виртуальных методов объекта IMyShellExtInit полность совпадает с набором функций интерфейса IShellExtInit. Метод Initialize извлекает из передаваемых вызывающей программой данных список файлов и сохраняет его в отдельном поле данных своего объекта-контейнера, тип которого обязательно должен быть ISEIContainer.

ISEIContainer наследует методы AddRef и Release контейнера IContainerUnknown. Имеющий собственную реализацию метода QueryInterface объект ISEIContainer сначала вызывает вариант QueryInterface, унаследованный от IContainerUnknown. Если полученное в ответ значение не равно S_OK, тогда с помощью его собственного метода QueryInterface проверяется, есть ли обращение к интерфейсу IShellExtInit. Если ответ положительный, этот метод передает указатель на свое поле типа protected FShellExtInit, являющееся объектом типа IMyShellExtInit. Кроме этого, в ISEIContainer описываются поля для хранения списка файлов, их числа и маршруты к ним. Имеющийся у него конструктор Create инициализирует список файлов и объекты FShellExtInit, а деструктор Destroy высвобождает память, отведенную для этих двух объектов.

Описание объекта IMyPersistFile кажется более сложным, чем у IMyShellExtInit. Однако в действительности пять из шести его методов, реализующих функции интерфейса IPersistFile, в качестве результата передают значение E_FAIL. Метод Load объекта IMyPersistFile получает имя файла в формате Unicode, преобразует его в строку ANSI и записывает в соответствующее поле своего объекта-контейнера, тип которого обязательно IPFContainer. Так же как у ISEIContainer, метод QueryInterface объекта IPFContainer имеет свои особенности. Сначала выполняется обращение к унаследованному варианту QueryInterface. Если в ответ получено значение ошибки, то с помощью собственного метода QueryInterface проверяется, есть ли обращения к интерфейсу IPersistFile. Если да, передается указатель на protected-поле FPersistFile - объект типа IMyPersistFile. За создание и удаление объекта FPersistFile отвечают специальные методы объекта-контейнера - конструктор и деструктор.

Теперь все готово и можно приступать к подготовке наших расширений оболочки Windows95.

Рис. 1. Иерархия объектов - расширений оболочки Windows

           <--------- IUnknown ----------->
          |           --------             |
          |                                |
   IContainerUnknown                  ISatelliteUnknown
   |                                                 |
   |-> IPFContainer  -----------> IMyPersistFile     |
   |   IPersistFile               IPersistFile   <---|
   |    |               -------->                    |
   |    |              |                             |
   |     ->IDSExtraction -------> IMyExtraction  <---|
   |       IPersistFile           IExtractIcon       |
   |       IExtractIcon                              |
   |                                                 |
   |                                                 |
    -->ISEIContainer -----------> IMyShellExtInit<---|
       IShellExtInit     -------> IShellExtInit      |
       |                |      ->                    |
       |                |                          |
       |-> IDSContextMenu ----> IMyContextMenu <---|
       |   IShellExtInit        IContextMenu       |
       |   IContextMenu                            |
       |              -------- |                     |
       |             |   ------                      |
       |-> IDSDragDrop -|-------> IMyDragDrop    <---|
       |   IShellExtInit|         IContextMenu       |
       |   IContextMenu |                            |
       |                |                            |
       |-> IDSPropSheet --------> IMyPropSheet   <---|
           IShellExtInit          IShellPropSheetExt
           IShellPropSheetExt

Лист. 1. Два объекта-сателлита реализуют вспомогательные интерфейсы, необходимые для работы таких расширений оболочки Windows 95, как обработчики контекстного меню, списка параметров, для механизма drag-and-drop и пиктограмм.


 type
   IMyShellExtInit = class(ISatelliteUnknown)
   public
     function Initialize(pidlFolder:PItemIDlist; lpdobj: IDataObject;
       hKeyProgID:HKEY) :HResult; virtual; stdcall;
   end;

   IMyPersistFile = class(ISatelliteUnknown)
   public
     function GetClassID(var classID: TCLSID): HResult; virtual;
      stdcall;
     function IsDirty: HResult; virtual; stdcall;
     function Load(pszFileName: POleStr; dwMode: Longint): HResult;
       virtual; stdcall;
     function Save(pszFileName: POleStr; fRemember: BOOL): HResult;
       virtual; stdcall;
     function SaveCompleted(pszFileName: POleStr): HResult;
       virtual; stdcall;
     function GetCurFile(var pszFileName: POleStr): HResult;
       virtual; stdcall;
   end;

   ISEIContainer = class(IContainerUnknown)
   protected
//Интерфейс объекта-сателлита
     FShellExtInit : IMyShellExtInit; 
   public
     FNumFiles         : Integer;
     FInitFiles        : TStringList;
     FIDPath           : String;
     constructor Create;
     destructor Destroy; override;
     function QueryInterface(const WantIID: TIID);
       var ReturnedObject): HResult; override;
   end;

   IPFContainer = class(IContainerUnknown)
   protected
//Интерфейс объекта-сателлита
     FPersistFile : IMyPersistFile; 
   public
     FPFFileName : String;
     constructor Create;
     destructor Destroy; override;
     function QueryInterface(const WantIID: TIID;
       var ReturnedObject): HResult; override;
   end;


Обработчик контекстного меню
Щелчок правой клавишей мыши на каком-то файле, в среде Windows 95 Explorer приводит к тому, что система предпринимает попытку выяснить, задан ли для такого типа файлов обработчик контекстного меню. Если таковой имеется, система создает экземпляр COM-объекта - обработчика контекстного меню и передает список выделенных файлов функции Initialize интерфейса IShellExtInit этого объекта. Затем обращается к методу QueryContextMenu интерфейса IContextMenu. В работе этой функции используются стандартные функции Windows API; например, для вставки дополнительных элементов меню или разделителей вызывается функция InsertMenu, которая передает в качестве return-значения число добавленных элементов, не считая разделителей. Если же пользователь выбрал один из этих внесенных элементов меню, то происходит вызов функции InvokeCommand интерфейса IContextMenu. Чтобы предоставить комментарий к данному элементу меню в строке состояний программы Explorer, вызывается функция GetCommandString.

Для определения и инициализации обработчика контекстного меню используются следующие Delphi-объекты: IMyContextMenu, IDSContextMenu и ICMClassFactory. Объект IMyContextMenu является потомком ISatelliteUnknown; его интерфейс IContextMenu реализует три функции. Объект IDSContextMenu - потомок ISEIContainer, поэтому снабжен интерфейсом IShellExtInit. В IDSContextMenu имеется дополнительное protected-поле FContextMenu с типом IMyContextMenu. И в этом случае конструктор и деструктор объекта IDSContextMenu ответственны за создание и удаление объекта-сателлита; при обращении к интерфейсу IContextMenu метод QueryInterface данного объекта передает в вызывающую программу указатель на объект FContextMenu.

Эта программа содержит также описание объекта ICMClassFactory - потомка IMyClassFactory, специально предназначенного для получения экземпляра IDSContextMenu. Метод CreateInstance создает запрашиваемый экземпляр и обеспечивает к нему доступ, но только если среди интерфейсов объекта IDSContextMenu имеется запрашиваемый. Для каждого из наших расширений оболочки потребуется почти такой же вариант потомка IMyClassFactory.

Метод QueryContextMenu предназначен для проверки того, сколько файлов выбирается: один или несколько. Если только один, в меню добавляется элемент под именем Magic Number (магический номер); если же их несколько - элемент Average Magic Number (усредненный магический номер). Метод InvokeCommand проверяет правильность переданных ему аргументов и выводит в окне сообщений запрошенный номер. Метод GetCommandString в соответствии с тем, что было запрошено, передает либо отдельное слово - наименование элемента меню, либо пояснительную строку.

Обработчик для механизма drag-and-drop
Обработчик для механизма drag-and-drop практически не отличается от обработчика контекстного меню - в них используется даже один и тот же интерфейс IContextMenu. Однако имеются некоторые отличия: во-первых, активизация расширения, предназначенного для обслуживания механизма drag-and-drop происходит при переносе файла в какую-то папку правой клавишей мыши; во-вторых, это расширение вносится в список файлов того типа, которые помещены в данную папку, а не к тому типу файлов, к которому относится перемещенный файл. Объект-сателлит IMyDragDrop содержит следующие методы: QueryContextMenu, InvokeCommand и GetCommandString.

Сначала метод QueryContextMenu выполняет просмотр переданного ему системой списка файлов с целью проверки, все ли относятся к типу DelShellFile. Если это так, данный метод добавляет в меню новый элемент Count Files (Подсчет файлов), разделитель и передает в качестве return-значение 1. Если же результат отрицательный, никаких действий не производится и передается значение 0. При выборе добавленного элемента меню метод InvokeCommand подсчитывает количество файлов в папке-получателе и добавляет это число к "магическому номеру" каждого из выделенных DelShellFile-файлов. Поскольку этот номер и пиктограмма такого файла взаимосвязаны, обращение к функции API, SHChangeNotify осведомит систему о необходимости обновить пиктограммы каждого из этих файлов.

В функциональном отношении объект-контейнер IDSDragDrop идентичен объекту IDSContextMenu. Разница лишь в том, что тип его объекта-сателлита - IMyDragDrop, а не IMyContextMenu.

Обработчик списка параметров
Когда пользователь, выделив один или несколько файлов, выбирает в контекстном меню команду Properties (Параметры), система сначала пытается определить, предусмотрен ли специальный обработчик списка параметров для данного типа файлов. Если да, система создает экземпляр соответствующего расширения оболочки и инициализирует, передав функции Initialize его интерфейса IShellExtInit список выделенных файлов. Система также обращается к функции AddPages интерфейса IShellPropSheetExt, с тем чтобы дать возможность обработчику списка параметров добавить к нему одну или несколько страниц. Другая функция интерфейса IShellPropSheetExt - ReplacePages - обычно не используется.

Однако, когда дело доходит до реализации метода AddPages, программисты, работающие с Delphi, внезапно оказываются в полной растерянности. Для создания страницы списка параметров необходим такой ресурс, как шаблон диалогового окна, и функция для его обработки. Лишь бывалые Windows-программисты, возможно, еще помнят о старинных предшественниках нынешних средств визуального программирования. Для подготовки шаблона диалогового окна можно воспользоваться инструментом для генерации ресурсов, таким, как Resource Workshop фирмы Borland или составить сценарий ресурса и откомпилировать его с помощью компилятора ресурсов BRCC.EXE, входящего в комплект Delphi. Вместе с исходными текстами для этой статьи можно загрузить и сценарий ресурса, описывающий список параметров для файлов типа DelShellFile.

Этот сценарий дает определения двух статических полей с текстом, окна списка и кнопки. В общем подключаемом файле SHEET.INC объявлены константы IDC_Static, IDC_ListBox и IDC_Button, используемые в качестве идентификаторов для управления диалоговым окном.

При исполнении метода AddPages происходит инициализация различных полей структуры TPropSheetPage, в том числе шаблона диалогового окна, процедуры управления им и параметра lParam, описанного в программе. Здесь lParam содержит список файлов, переданных из оболочки Windows. Использование функции обратного вызова гарантирует освобождение памяти, выделенной под этот список. При обращении к функции CreatePropertySheetPage она создает страницу на основании данных структуры TPropSheetPage, а при вызове предусмотренной в оболочке функции lpfnAddPage к диалоговому окну Properties будет добавлена эта страница.

Процедура управления диалоговым окном обрабатывает два конкретных сообщения. Если поступает сообщение WM_INITDIALOG, окно списка дополняется перечнем файлов, указанным в поле параметра lParam данной страницы списка параметров. Перед каждым именем проставляется соответствующий "магический номер". Затем процедура формирует статический элемент управления, отображающий количество выбранных в данный момент файлов. Список файлов удаляется, а поле, где прежде находился данный список файлов, обнуляется.

Если же пользователь щелкнет на кнопке Zero Out (Очистить), процедура управления диалоговым окном получает сообщение WM_COMMAND, где в младшем слове wParam указывается идентификатор данной кнопки. Процедура просматривает весь список файлов и делает нулевым "магический номер" каждого из них, затем обращается к функции API - SHChangeNotify, чтобы сообщить системе о необходимости перерисовать пиктограммы файлов. Фактически любая процедура управления диалоговым окном списка параметров должна иметь средства для реакции на сообщение WM_INITDIALOG, чтобы выполнить инициализацию своих управляющих элементов. Если же она предназначена не только для отображения информации, тогда в ней должны быть средства, обеспечивающие реакцию на сообщения WM_COMMAND, поступающие от конкретных управляющих элементов.

Обработчик пиктограмм
В большинстве случаев средства оболочки Windows 95 просто выбирают для файла ту пиктограмму, которая указана для такого типа файлов в разделе DefaultIcon системного реестра. Однако, если в разделе DefaultIcon задано значение %1, тогда происходит обращение к некоторому расширению оболочки, которое выполняет роль обработчика пиктограмм для данного файла. Система обращается к функции Load интерфейса IPersistFile этого расширения, передавая ей в качестве параметра имя файла. Обработчик пиктограмм обеспечивает соответствующую пиктограмму через функции GetIconLocation и Extract своего интерфейса IExtractIcon. Эта информация представляет собой либо имя файла и порядковый номер конкретной пиктограммы, либо созданную при поступлении запроса пиктограмму.

Наш пример объекта-сателлита IMyExtractIcon реализует оба варианта. Если задана директива условной компиляции UseResource, метод GetIconLocation присваивает аргументу szIconFile в качестве значения имя DLL-модуля, содержащего объект IMyExtractIcon, затем на основании "магического номера" файла вычисляет значение аргумента piIndex. Данный метод включает в значение аргумента pwFlags флажок GIL_PERINSTANCE, наличие которого означает, что каждый файл может иметь свою отдельную пиктограмму и флажок GIL_DONTCACHE - знак того, что система не должна сохранять эту пиктограмму в памяти для последующих применений. Метод Extract в этом случае не используется; его return-значение будет S_FALSE.

Если же директива условной компиляции UseResource не задана, тогда объект-сателлит IMyExtractIcon формирует пиктограмму для каждого файла. Метод GetIconLocation заносит "магический номер" данного файла в аргумент piIndex и помимо упомянутых выше флажков использует флажок GIL_NOTFILENAME. Из оболочки вызывается метод Extract, который создает для данного файла пиктограммы двух размеров - крупную и маленькую. Высота красной полоски в прямоугольнике пиктограммы определяется "магическим номером" файла. В исходных текстах, прилагаемых к этой статье, представлена процедура создания пиктограммы на ходу. Однако, поскольку она имеет лишь косвенное отношение к тематике этой статьи, ее подробности здесь не обсуждаются.

Компоновка программы
Для того чтобы все перечисленные расширения оболочки работали, нужно скомпилировать их в DLL-модуль, содержащий стандартные функции DllGetClassObject и DllCanUnloadNow. В числе исходных текстов, прилагающихся к этой статье, имеется и программа, описывающая такой DLL-модуль. Функция DllGetClassObject выполняет следующие операции: выясняет, к какому объекту поступил запрос, формирует соответствующую фабрику классов (class factory) и передает в качестве результата объект, созданный этой фабрикой. Среди упомянутых исходных текстов вы найдете также программу, описывающую DLL-модуль несложной консольной процедуры, управляющей операциями внесения и удаления из системного реестра информации обо всех перечисленных здесь образцах расширений оболочки.

Теперь, изучив приведенные примеры, можно приступать к созданию собственных расширений оболочки. Только не забудьте заменить имеющиеся в текстах программ значения глобально уникальных идентификаторов GUID (Globally Unique Identifiers) новыми. В этом вам поможет программа генерации, GUIDS, представленная в первой части этой статьи.

Средства для отладки COM объектов
Большинство современных пакетов для разработки программ содержат встроенные средства отладки, обеспечивающие возможность выполнения в пошаговом режиме, трассировки кода, установки точек прерывания и просмотра значений переменных. Все они пригодны для отладки исполнимых EXE-модулей. Однако если программа оформлена в виде DLL-модуля, то интегрированные средства отладки оказываются бесполезными. Даже при использовании 32-разрядного автономного отладчика не так-то просто добраться до COM объектов, поскольку они выполняются в адресном пространстве обратившегося к ним объекта или программы. Например, COM объекты, являющиеся расширениями оболочки Windows 95, исполняются в адресном пространстве программы Windows Explorer.

Однако чаще всего разработчика интересуют достаточно простые вопросы о работе COM объектов: Был ли загружен DLL-модуль вообще? Производилась ли попытка создать экземпляр конкретного COM объекта? Какой интерфейс запрашивался? Выяснить все это можно с помощью простого механизма регистрации сообщений: COM объект отправляет сообщения о своем состоянии, которые принимает и регистрирует предназначенная для этого самостоятельная программа. Из службы PC Magazine Online вы можете загрузить специальный модуль DllDebug, который обеспечивает механизм передачи таких сообщений.

Раздел этого модуля, который выполняет инициализацию, присваивает переменной WM_LOGGIT уникальное значение идентификатора сообщений, полученное от функции RegisterWindowMessage в результате передачи ей строковой переменной Debugging Status Message. При первом обращении к функции RegisterWindowMessage с использованием этой строки она передает уникальный номер сообщения, а при последующих вызовах с ней в качестве результата будет получен тот же номер.

Поскольку 32-разрядные программы выполняются в отдельном адресном пространстве, функция Loggit не может так просто передать указатель на свою строку с сообщением о состоянии. В адресном пространстве принимающей программы этот указатель будет недействителен. Поэтому функция Loggit вносит это сообщение в таблицу глобальных элементов системы Windows (global atom table). После этого она обращается к функции SendMessage, передавая ей следующие параметры: значение -1 для дескриптора окна, WM_LOGGIT в качестве номера сообщения и элемент для wParam. Функция SendMessage сохраняет за собой управление до тех пор, пока действующие в системе окна верхнего уровня не обработают это сообщение. Теперь этот элемент можно безболезненно удалить.

При подготовке сообщений о состоянии очень кстати придется функция NameOfIID, предусмотренная в модуле DllDebug. Согласно документации, она передает идентификаторы интерфейсов IIDs, реализуемых расширениями оболочки. Однако к ним можно добавить любые значения системных IID, необходимых для вашего проекта. Например, в тело метода QueryInterface можно было бы вставить следующую строку:


   Loggit(Format('QueryInterface: %s requested', [NameOfIID(WantIID)]));


Организовать передачу сообщения WM_LOGGIT - это еще полдела. Нужна программа, которая будет принимать и регистрировать сообщения о производимых операциях. Утилита Logger, предлагаемая службой PC Magazine Online, - один из возможных вариантов решения этой задачи.

Поскольку значение, имеющееся в сообщении WM_LOGGIT, становится известным только в процессе исполнения, нет возможности задать стандартный метод обработки сообщения. Поэтому в программе Logger переопределяется интерфейсный метод DefaultHandler. При прохождении сообщения WM_LOGGIT этот метод извлекает сообщение о состоянии из передаваемого элемента и добавляет его в имеющийся список окна просмотра. Помимо этой основной функции она обслуживает три рабочие кнопки - для вставки комментария пользователя, для очистки окна списка и для сохранения зарегистрированных сообщений в файле. На рис. А вы видите момент выполнения программы Logger.

В приведенном диалоговом окне представлены методы QueryInterface нескольких COM объектов, подготовленных в среде Delphi, инструментированные строкой, в которой регистрируется имя запрашиваемого интерфейса. Перед вами список запросов, отправленных, когда Explorer извлек пиктограмму для некоторого файла, затем пользователь щелкнул на ней правой клавишей мыши и просмотрел его параметры. Все работает правильно. Если же наша утилита вдруг выводит на экран неожиданные результаты, тогда в сомнительный фрагмент своей программы можно добавить новые обращения к функции Loggit и повторять эксперимент до тех пор, пока не удастся найти ошибку.

© Нил Дж. Рубенкинг
Материал взят с PC Magazine, January 21, 1997


Взято с сайта

Создание DBExpress-Connection в Run-Time

Создание DBExpress-Connection в Run-Time

procedureTVCLScanner.PostUser(const Email, FirstName, LastName: WideString); 
var 
  Connection: TSQLConnection; 
  DataSet: TSQLDataSet; 
begin 
  Connection := TSQLConnection.Create(nil); 
  with Connection do 
  begin 
    ConnectionName := 'VCLScanner'; 
    DriverName := 'INTERBASE'; 
    LibraryName := 'dbexpint.dll'; 
    VendorLib := 'GDS32.DLL'; 
    GetDriverFunc := 'getSQLDriverINTERBASE'; 
    Params.Add('User_Name=SYSDBA'); 
    Params.Add('Password=masterkey'); 
    Params.Add('Database=milo2:D:\frank\webservices\umlbank.gdb'); 
    LoginPrompt := False; 
    Open; 
  end; 
  DataSet := TSQLDataSet.Create(nil); 
  with DataSet do 
  begin 
    SQLConnection := Connection; 
    CommandText := Format('INSERT INTO kings VALUES("%s","%s","%s")', 
      [Email, FirstN, LastN]); 
    try 
      ExecSQL; 
    except 
    end; 
  end; 
  Connection.Close; 
  DataSet.Free; 
  Connection.Free; 
end;

Взято из

Создание DTD для объекта (XML)

Создание DTD для объекта (XML)

За созданием кода для сериализации и десериализации объектов в Delphi логично перейти к рассмотрению вопроса о возможности генерации соответствующего DTD для сохраняемых в XML классов. DTD понадобится нам, если мы захотим провести проверку XML документа на корректность и допустимость с помощью одного из XML анализаторов. Работа с анализатором MSXML рассмотрена в статье Загрузка и анализ документа XML..

Автоматическое создание DTD очень простая задача. У нас все для этого есть. Необходимо рекурсивно пройтись по всем свойствам объекта и сгенерировать модели содержания для каждого тега. При сериализации в XML мы не использовали атрибутов, а значит мы не сможем в DTD установить контроль над содержанием конкретных элементов. Остается только определить модель содержания для XML, т.е. вложенность тегов в друг друга.

Создадим процедуру GenerateDTD(), которая обеспечит запись формируемого DTD для заданного объекта Component в заданный поток Stream. Она создает список DTDList, в котором будут накапливаться атрибуты DTD, после чего передает всю черновую работу процедуре GenerateDTDInternal().



{
Процедурагенерации DTD для заданного объекта в
соответсвии с published интерфейсом его класса.

Вход:
  Component - объект
Выход:
  текст DTD в поток Stream
}
procedure GenerateDTD(Component: TObject; Stream: TStream);
var
  DTDList: TStringList;
begin
  DTDList := TStringList.Create;
  try
    GenerateDTDInternal(Component, DTDList, Stream, Component.ClassName);
  finally
    DTDList.Free;
  end;
end;

 


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

Для всех неклассовых типов модель содержания это - (#PCDATA). К примеру, свойство объекта Tag: integer превращается в .

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



{
Внутренняя рекурсивная процедура генерации DTD для заданного объекта.

Вход:
  Component - объект
  DTDList - список уже определенных элементов DTD
  для предотвращения повторений.
Выход:
  текст DTD в поток Stream
}
procedure GenerateDTDInternal(Component: TObject; DTDList: TStrings;
  Stream: TStream; const ComponentTagName: string);
var
  PropInfo: PPropInfo;
  TypeInf, PropTypeInf: PTypeInfo;
  EnumInfo: PTypeInfo;
  TypeData: PTypeData;
  i, j: integer;
  AName, PropName, sPropValue, s, TagContent: string;
  PropList: PPropList;
  NumProps: word;
  PropObject: TObject;
const
  PCDATA = '#PCDATA';

  procedure addElement(const ElementName: string; Data: string);
  var
    s: string;
  begin
    if DTDList.IndexOf(ElementName) <> -1 then
      exit;
    DTDList.Add(ElementName);
    s := 'then'
      Data := PCDATA;
    s := s + '(' + Data + ')>'#13#10;
    Stream.write(PChar(s)[0], length(s));
  end;

begin
  { Playing with RTTI }
  TypeInf := Component.ClassInfo;
  AName := TypeInf^.name;
  TypeData := GetTypeData(TypeInf);
  NumProps := TypeData^.PropCount;


  GetMem(PropList, NumProps*sizeof(pointer));
  try
    { Получаем список свойств }
    GetPropInfos(TypeInf, PropList);
    TagContent := '';

    for i := 0 to NumProps-1 do
    begin
      PropName := PropList^[i]^.name;

      PropTypeInf := PropList^[i]^.PropType^;
      PropInfo := PropList^[i];

      { Пропустить не поддерживаемые типы }
      if not (PropTypeInf^.Kind in [tkDynArray, tkArray,
      tkRecord, tkInterface, tkMethod]) then
      begin
        if TagContent <> '' then
          TagContent := TagContent + '|';
        TagContent := TagContent + PropName;
      end;

      case PropTypeInf^.Kind of
        tkInteger, tkChar, tkFloat, tkString,
        tkWChar, tkLString, tkWString, tkVariant,
        tkEnumeration, tkSet:
        begin
          { Перевод в DTD. Для данных типов модель содержания - #PCDATA }
          addElement(PropName, PCDATA);
        end;

        {
        Kод был бы полезен при использовании атрибутов
        tkEnumeration:
        begin
          TypeData:= GetTypeData(GetTypeData(PropTypeInf)^.BaseType^);
          s := '';
          for j := TypeData^.MinValue to TypeData^.MaxValue do
          begin
            if s <> '' then s := s + '|';
            s := s + GetEnumName(PropTypeInf, j);
          end;
          addElement(PropName, s);
        end;
        }

        tkClass: { Для классовых типов рекурсивная обработка }
        begin
          PropObject := GetObjectProp(Component, PropInfo);
          if Assigned(PropObject)then
          begin
            { Для дочерних свойств-классов - рекурсивный вызов }
            if (PropObject is TPersistent) then
              GenerateDTDInternal(PropObject, DTDList, Stream, PropName);
          end;
        end;
      end;
    end;

    { Индивидуальный подход к некоторым классам }
    { Для коллекций необходимо включить в модель содержания тип элемента }
    if (Component is TCollection) then
    begin
      if TagContent <> '' then
        TagContent := TagContent + '|';
      TagContent := TagContent + (Component as TCollection).ItemClass.ClassName + '*';
    end;

    { Добавляем модель содержания для элемента }
    addElement(ComponentTagName, TagContent);
  finally
    FreeMem(PropList, NumProps*sizeof(pointer));
  end;
end;




Закоментированный код нам не нужен, но он не удален, т.к. он демонстрирует получение списка возможных значений для перечисления (Enumeration) и набора (Set). Это может понадобится, если появится необходимость генерировать свойства в виде атрибутов XML тегов и, соответственно, DTD для возможных значений этих атрибутов.

Взято с

Создание и удаление полей во время выполнения программы

Создание и удаление полей во время выполнения программы

TField-компоненты (или, точнее, потомки компонента TField с соответствующим типом поля) могут создаваться во время проектирования программы с помощью Fields Editor (редактора полей). Fields Editor вызывается двойным щелчком на иконке компонента TTable или TQuery. Но потомки TField могут быть созданы и удалены и в режиме выполнения программы.

Потомки компонента TField (такие как, например, TStringField, TIntegerField и др.) создаются методом Create для того типа потомка TField, который подходит к соответствующему полю набора данных. Другими словами, для поля строкового типа текущего набора данных необходимо вызвать метод Create класса TStringField, являющегося потомком TField. Методу Create необходим один параметр - владелец потомка TField, расположенный на TForm. После создания компонента наследника TField для того, чтобы новый экземпляр объекта мог установить связь с необходимым полем набора данных, необходимо установить несколько ключевых свойств. Вот их список:


FieldName: имя поля в таблице
Name: уникальный идентификатор компонента-потомка TField.
Index: позиция компонента-потомка TField в массиве TFields (свойство Fields компонента TTable или TQuery, с которым будет связан TField).
DataSet: компонент TTable или TQuery, с которым будет связан TField.
Приведенный ниже код демонстрирует способ создания TStringField. TForm названа Form1 (здесь ссылка на переменную Self), активный набор данных TQuery имеет имя Query1 и поле, для которого создается компонент TStringField, расположено в таблице dBASE с именем CO_NAME. Новый потомок TField будет вторым TField в свойстве-массиве Fields компонента Query1. Имейте в виду, что набор данных, связанный с новым потомком TField (в нашем случае Query1), перед добавлением TField должен быть закрыт, а после добавления вновь открыт.

procedureTForm1.Button2Click(Sender: TOObject);
var
  T: TStringField;
begin
  Query1.Close;
  T := TStringField.Create(Self);
  T.FieldName := 'CO_NAME';
  T.Name := Query1.Name + T.FieldName;
  T.Index := Query1.FieldCount;
  T.DataSet := Query1;
  Query1.FieldDefs.UpDate;
  Query1.Open;
end;

Вышеприведенный пример создает новый TStringField с именем Query1CO_NAME.

Для удаления существующего потомка TField достаточно вызова метода Free данного компонента. В примере, приведенном ниже, метод TForm FindComponent используется для получения указателя на компонент TStringField с именем Query1CO_NAME. Возвращаемая функцией FindComponent величина в случае успешного завершения будет иметь тип TComponent или nil в противном случае. Возвращаемое значение может использоваться для того, чтобы определить, действительно ли существует компонент до того, как будет применен метод Free.

procedure TForm1.Button1Click(Sender: TObject);
var
  TC: TComponent;
begin
  TC := FindComponent('Query1CO_NAME');
  if not (TC = nil) then 
  begin
    Query1.Close;
    TC.Free;
    Query1.Open;
  end;
end; 

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

Взято из

Создание иконок из ресурсов

Создание иконок из ресурсов

Вот небольшая статейка, найденная мной в FAQ(). Может пригодится?

Функция CreateIconFromResourceEx создает иконку или курсор из битов ресурса, описывающих иконку.

перевод функции CreateIconFromResourceEx. CreateIconFromResourceEx Функция CreateIconFromResourceEx создает иконку или курсор из битов ресурса,
описывающих иконку. HICON CreateIconFromResourceEx( PBYTE pbIconBits, // указатель на биты ресурса
DWORD cbIconBits, // число бит в буфере
BOOL fIcon, // флаг иконки или курсора
DWORD dwVersion, // версия формата Windows
int cxDesired, // желаемая ширина иконки или курсора
int cyDesired, // желаемая высота иконки или курсора
UINT uFlags
); Параметры pbIconBits ? указывает на буфер, содержащий биты ресурса иконки или курсора.
Эти биты обычно загружаются вызовами функций LookupIconIdFromDirectory (в Windows
95 вы также можете использовать функцию LookupIconIdFromDirectoryEx) и LoadResource.
cbIconBits ? определяет размер, в байтах, набора битов, на который указывает
параметр pbIconBits.
fIcon ? определяет, будет ли создаваться иконка или курсор. Если значение этого
параметра равно TRUE, создается иконка. Иначе создается курсор.
dwVersion ? определяет номер версии формата иконки или курсора для битов ресурса,
на которые указывает параметр pbIconBits. Параметр может принимать одно из следующих
значений: Формат Значение
Windows 2.x 0x00020000
Windows 3.x 0x00030000 Все Win32 приложения должны использовать для иконок и курсоров формат Windows
3.x.
cxDesired ? определяет желаемую ширину иконки или курсора в пикселях. Если значение
этого параметра равно нулю, функция использует значения метрики системы SM_CXICON
или SM_CXCURSOR для установки ширины.
cyDesired ? определяет желаемую высоту иконки или курсора в пикселях. Если значение
этого параметра равно нулю, функция использует значения метрики системы SM_CXICON
или SM_CXCURSOR для установки высоты.
uFlags ? определяет комбинацию из следующих значений: Значение Пояснение
LR_DEFAULTCOLOR Используется цветовой формат по умолчанию.
LR_MONOCHROME Создается монохромная иконка или курсор. Возвращаемые значения В случае успеха возвращается дескриптор иконки или курсора.
В случае неудачи возвращается нуль. Для получения дополнительной информации об
ошибке вызовите функцию GetLastError. Комментарии Функции CreateIconFromResourceEx, CreateIconFromResource, CreateIconIndirect,
GetIconInfo и LookupIconIdFromDirectoryEx позволяют приложениям оболочки и браузерам
иконок проверять и использовать ресурсы См. также BITMAPINFOHEADER, CreateIconFromResource, CreateIconIndirect, GetIconInfo, LoadResource,
LookupIconIdFromDirectoryEx . хелп по WinAPI:

Взято с Vingrad.ru

Создание или открытие книги

Создание или открытие книги

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

 property IWorkbook: Excel8TLB._Workbook read FIWorkbook;


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

if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
   FIWorkbook := IXLSApp.Workbooks.Add(EmptyParam, 0);



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

Коллекция Workbooks содержит все открытые книги и предоставляет возможность кое-как управлять всем этим.

Боже, как убоги коллекции от Microsoft, и особенно поиск в них! Я отклонюсь, но это надо видеть. Вот пример поиска книги с заданным именем, приведенный как совет в MSDN Office Developer.

Public Function SheetExists(strSearchFor As String) As Boolean
SheetExists = False
For Each sht In ThisWorkbook.Worksheets
    If sht.Name = strSearchFor Then
        SheetExists = True
    End If
Next sht
End Function

 

Это вам не IndexOf писать. Сами ищите! А я так иделаю. Но, далее…

Метод Add этой коллекции (читай, метод интерфейса) позволяет добавить книгу к этой коллекции, пустую либо по шаблону. Первый параметр этого метода, Template (из справки по Excel VBA), может принимать имя файла с путем. Поэтому, выполнив код

if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
  FIWorkbook := IXLSApp.Workbooks.Add(ExtractFilePath(ParamStr(0)) + 'Test.xls', 0);


вы получите книгу, идентичную файлу "Test.xls" с именем Test1.xls. Именно этим способом я создаю все свои отчеты, так как создаю их по заранее разработанным шаблонам. Естественно, что это шаблоны XL Report.

Если же необходимо просто открыть уже существующий файл, то используйте метод Open этой же коллекции:

if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
  FIWorkbook := IXLSApp.Workbooks.Open(ExtractFilePath(ParamStr(0)) + "Test.xls', EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
    EmptyParam, EmptyParam, EmptyParam, false, 0);


Понимаю, что в душе нормального программиста такой код вызовет отвращение. Как-то я даже получил гневное письмо о собственной ненормальности из-за того, что использую ранее связывание и кучу EmptyParam. Впрочем, я не сильно агрессивный человек (правда, только в переписке), и отвечать не стал. В конечном итоге, раннее связывание дает мне немного преимуществ, но я за него. Я не могу помнить все методы и их параметры из Excel Type Library, поэтому получаю их (только при раннем связывании, естественно) из подсказок редактора Delphi - продуманная вещь этот редактор. А чтобы не мучаться с написанием такого количества EmptyParam, можно написать и так (ответ на «гневное» письмо):

if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
  IDispatch(FIWorkbook) := OLEVariant(IXLSApp.Workbooks).Open(
    FileName := ExtractFilePath(ParamStr(0)) + 'Test.xls');



Но, мы отклонились. Что же стоит за таким количеством параметров по умолчанию в методе Open? Да, много чего. Из этого «громадья» я использую лишь несколько вещей. Их я и опишу, а заинтересовавшихся остальными отсылаю к справке по Excel VBA. Вот объявление этого метода в импортированной библиотеке типов:
 function Open(const Filename: WideString; UpdateLinks: OleVariant; ReadOnly: OleVariant;
              Format: OleVariant; Password: OleVariant; WriteResPassword: OleVariant; 
              IgnoreReadOnlyRecommended: OleVariant; Origin: OleVariant; 
              Delimiter: OleVariant; Editable: OleVariant; Notify: OleVariant; 
              Converter: OleVariant; AddToMru: OleVariant; lcid: Integer): Workbook; safecall;

В FileName необходимо передать имя открываемого файла, желательно указав путь его нахождения. Иначе, этот файл Excel будет искать в каталоге по умолчанию. Чтобы файл был запомнен в списке последних открытых файлов, в AddToMru можно передать true. Иногда я знаю, что файл рекомендован только для чтения (не путать с «парольной» защитой книги). Тогда при открытии выдается соответствующее сообщение. Чтобы игнорировать его, можно передать в IgnoreReadOnlyRecommended true. Вот, пожалуй, и все мои скудные знания об этом методе. Впрочем, с помощью его мне приходилось открывать и файлы текстовых форматов с разделителями. Но тогда я обращался к чудесному «пишущему» плейеру VBA и записывал с его помощью макросы, затем правил их по необходимости и все отлично получалось. Этим же способом разрешать «всяческие» тонкие вопросы рекомендую и вам.

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

procedure TForm1.btnCreateBookClick(Sender: TObject); 
var FullFileName: string;
begin
  FullFileName := ExtractFilePath(ParamStr(0)) + 'Test.xls';
  if Assigned(IXLSApp) and (not Assigned(IWorkbook) ) then
    try
      case rgWhatCreate.ItemIndex of
      // По шаблону
      0: FIWorkbook := IXLSApp.Workbooks.Add(FullFileName, 0);
      // Просто откроем
      1: FIWorkbook := IXLSApp.Workbooks.Open(FullFileName,
           EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam,
           EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, false, 0);
      // Пустая книга
      2: FIWorkbook := IXLSApp.Workbooks.Add(EmptyParam, 0);
      end;
    except
      raise Exception.Create('Не могу создать книгу!');
    end;
end; 



Автор Евгений Старостин
Взято с сайта

Создание индекса

Создание индекса

Автор: OAmiry (Borland)

Ниже приведен код обработчика кнопки OnClick, с помощью которого строится индекс:

procedureTForm1.Button1Click(Sender: TObject);
var
  bActive, bExclusive: Boolean;
begin
  bActive := Table1.Active;
  bExclusive := Table1.Exclusive;
  Table1.IndexDefs.Update;
  with Table1 do
  begin
    Close;
    {таблица dBASE должна быть открыта в монопольном (exclusive) режиме}
    Exclusive := TRUE;
    Open;
    if Table1.IndexDefs.IndexOf('FNAME') <> 0 then
      Table1.AddIndex('FNAME', 'FNAME', []);
    Close;
    Exclusive := bExclusive;
    Active := bActive;
  end;
end;

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

Взято из

Создание индексного файла из Delphi

Создание индексного файла из Delphi

Создание индексного файла из Delphi
Если вы используете таблицы dBASE или Paradox, то для создания нового индекса
воспользуйтесь методом AddIndex. Для примера:

    Table1.AddIndex('Articles','Title', []) ; 

создаст индексный файл с именем ARTICLES с использованием поля TITLE в качестве индексного ключа.
При создании вы можете воспользоваться различными индексными опциями
(например, уникальность, необслуживаемый и пр.)
-- для получения дополнительной информации обратитесь к
электронной справке по Delphi.
ПРИМЕЧАНИЕ: Ваша таблица должна быть открыта исключительно для того,
чтобы только воспользоваться методом AddIndex.

Поддержка/обновление индексного файла,
если только при создании вы не выставили флаг "необслуживаемый"
(Maintenance-free), происходит автоматически.

Взято с сайта

Создание кросс-таблицы

Создание кросс-таблицы

Вы можете создать их в DBD как QBE-шки. Пользуясь компонентом TQBE для загрузки одной из библиотек, вы можете непосредственно использовать QBE-шки в вашем Delphi-приложении.

В следующем примере предполагается, что каждый служащий каждый день сообщает оператору о своем месторасположении. Код определяет начало трудовой недели с понедельника плюс еще четыре рабочих дня с показом соответствующей даты. Строки с 1 по 5 в QBE1.QBE (нулевая описательная) в нижеприведенной процедуре заменяются кодом. Результат всего этого в том, что строка (если имеется) для каждого человека отображается в колонке установленного результата и значение 'X' включается если только запись существует. Для создания агрегатной таблицы можно было бы подсчитывать результаты.

Текст в QBE1.QBE :


CALLIN.DB| StaffNo   | Date    |
          | _join1    | 3/10/95 |
          | _join2    | 3/11/95 |
          | _join3    | 3/12/95 |
          | _join4    | 3/13/95 |
          | _join5    | 3/14/95 |
 
XTAB.DB   | StaffNo   |Mon       |Tue       |Wed       |Thu       |Fri       |
          | _join1    |changeto X|          |          |          |          |
          | _join2    |          |changeto X|          |          |          |
          | _join3    |          |          |changeto X|          |          |
          | _join4    |          |          |          |changeto X|          |
          | _join5    |          |          |          |          |changeto X|




procedure TCallInReport.ButtonSelectClick(Sender: TObject);
begin
  TableXTab.active := false;
  if EditWeekOf.Text = '' then
  begin
    messageBeep(0);
    messageDlg('Для выбора записи необходима дата.', mtInformation, [mbOK], 0);
    exit;
  end;

  Screen.Cursor := crHourGlass;

  dtWeekOf := StrToDate(EditWeekOf.Text);
  dtStartDate := dtWeekOf - DayOfWeek(dtWeekOf) + 2;

  TableXTab.active := false;
  TableXTab.EmptyTable;
  TableXTab.active := true;

  {
  Замените строки 1 - 5 в QBE1.QBE реальными датами
  }
  QBE1.QBE.Strings[1] := '  | _join1  | ' + DateToStr(dtStartDate) + ' | ';
  QBE1.QBE.Strings[2] := '  | _join2  | ' + DateToStr(dtStartDate + 1) + ' | ';
  QBE1.QBE.Strings[3] := '  | _join3  | ' + DateToStr(dtStartDate + 2) + ' | ';
  QBE1.QBE.Strings[4] := '  | _join4  | ' + DateToStr(dtStartDate + 3) + ' | ';
  QBE1.QBE.Strings[5] := '  | _join5  | ' + DateToStr(dtStartDate + 4) + ' | ';

  try
    QBE1.active := true;
  except
    on E: EDataBaseError do
    begin
      if E.Message = 'Ошибка создания дескриптора курсора' then
        { Ничего не делайте. Делая TQBE активной, мы пытаемся создать курсор.
          Это вызывает исключительную ситуацию, которую мы должны перехватить.
          Пока я не нашел способа как отделаться от исключения. }
      else
      begin
        Screen.Cursor := crDefault;
        raise;
      end;
    end;
  else
    Screen.Cursor := crDefault;
    raise;
  end;
  TableXTab.refresh;
  Screen.Cursor := crDefault;
  TableXTab.active := true;
end;

Взято из

Создание ловушек в Delphi

Создание ловушек в Delphi

Автор: Chris Cummings (http://wibblovia.topcities.com)

Рано или поздно каждый программист сталкивается с таким понятим как ловушки. Чтобы приступить к ипользованию ловушек необходимо обзавестись windows SDK, который можно так же скачать с сайта Microsoft. В прилагаемом к статье архиве содержатся два проекта: hooks.dpr - это пример приложения работающего с ловушками, а hookdll.dpr - собственно сама DLL.
Что такое ловушки (Hooks)?
Проще говоря, ловушка - это функция, которая является частью DLL или часть Вашего приложения, при помощи которой можно контролировать 'происходящее' внутри окошек операционной системы. Идея состоит в том, чтобы написать функцию, которая будет вызываться каждый раз, когда будет возникать определённое событие - например, когда пользователь нажмёт клавишу или переместит мышку. Ловушки были задуманы Microsoft в первую очередь, чтобы облегчить программистам отладку приложений. Однако существует множество способов использования ловушек - например, чаще всего при помощи ловушек пишутся клавиатурные шпионы.

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

Процедуры ловушки
Далее следует краткое описание каждой процедуры и структуры, необходимой для ловушки.
функция The SetWindowsHookEx
Функция SetWindowsHookEx необходима для установки ловушки. Давайте посмотрим на аргументы данной функции:

Name

Type

Description

idHook    Integer    Число, представляющее тип ловушки - например WH_KEYBOARD    
lpfn    TFNHookProc    Адрес в памяти функции ловушки    
hMod    Hinst    Дескриптор dll в которой находится функция. Если это локальная ловушка, то этот параметр 0.    
dwThreadID    Cardinal    'id потока', который Ваша программа будет контролировать. Если это глобальная ловушка, то параметр должен быть 0.    

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

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

Name

Type

Description

Code    Integer    Указывает на то, что означают следующие два параметра    
wParam    word    Параметр размером в 1 слово (word)    
lParam    longword    Параметр размером в 2 слова   

Функция hook возвращает значение типа longword.

Функция CallNextHookEx
Данная функция предназначена для работы с цепочкой функций ловушек. Когда ловушка установлена на определённое событие, то может возникнуть такая ситуация, когда кто-нибудь тоже захочет установить ловушку на это же событие. Когда Вы устанавливаете ловушку при помощи SetWindowsHookEx, то Ваша процедура ловушки добавляется в начало списка процедур ловушек. Поэтому основная задача функции CallNextHookEx заключается в том, чтобы вызвать следующий в списке обработчик ловушки. Когда Ваша процедура ловушки завершится, то она должна вызовать CallNextHookEx, а затем вернуть заданное значение, в зависимости от типа ловушки.
Функция UnhookWindowsHookEx
Данная функция просто напросто удаляет Вашу ловушку. Единственный аргумент этой функции - это дескриптор ловушки, возвращаемы функцией SetWindowsHookEx.
Локальная ловушка
Сперва давайте создадим локальную ловушку. Необходимый для неё код содержится в 'local.pas'. При запуске Hooks.exe будет отображена небольшая форма. Для использования локальной ловушки достаточно нажать кнопку Add/Remove Local Hook на этой форме. После установки локальной ловушки, Вы заметите, что при нажатии и отпускании любой клавиши будет раздаваться звуковой сигнал (естевственно, когда hooks.exe будет иметь фокус. Ведь это локальная ловушка).
Самая первая функция в local.pas - SetupLocalHook, которая соственно и создаёт локальную ловушку, указывая на процедуру ловушки KeyboardHook. В данном случае это простой вызов SetWindowsHookEx, и, если возвращённый дескриптор > 0, указывающий на то, что процедура работает, то сохраняет этот дескриптор в CurrentHook и возвращает true, иначе будет возвращено значение false. Далее идёт функция RemoveLocalHook, которая получает в качестве параметра сохранённый дескриптор в CurrentHook и использует его в UnhookWindowsHookEx для удаления ловушки. Последняя идёт процедура hook, которая всего навсего проверяет - была ли отпущена клавиша и если надо, то выдаёт звуковой сигнал.
Глобальная ловушка
Глобальная ловушка выглядит немного сложнее. Для создания глобальной ловушки нам понадобится два проекта - певый для создания исполняемого файла и второй для создания DLL, содержащей процедуру ловушки. Глобальная ловушка, которая представлена в примере, сохраняет в файле log.txt каждые 20 нажатий клавиш. Чтобы использовать глобальную ловушку, достаточно на форме hook.exe нажать кнопку add/remove global hook. Затем, например, в записной книжке (notepad) достаточно набрать какой-нибудь текст, и Вы увидите, что в log.txt этот текст сохранится.
Наша Dll содержит две процедуры. Первая - это процедура hook, которая идентична для той, которую мы рассмотрели для локальной ловушки. Вторая процедура необходима инициализации dlls, и содержит текущий номер клавиши, которая была нажата, а также дескриптор ловушки, которая была создана.
Исполняемый файл сперва должен загрузить процедуры из DLL, а затем использовать SetWindowsHookEx, чтобы создать глобальную ловушку.
В заключении...
Представленный пример объясняет - как перехватывать события клавиатуры. Чтобы узнать, как использовать ловушки других типов, таких как WH_MOUSE, необходимо разобраться с windows SDK.

Приложения:

library HookDll;

uses
  SysUtils,
  Classes,windows;

var CurrentHook: HHook;
    KeyArray: array[0..19] of byte;
    KeyArrayPtr: integer;
    CurFile: file of byte;
{
GlobalKeyboardHook
------------
This is the hook procedure to be loaded from hooks.exe when you
try and create a global hook. It is similar in structure to that defined
in hook.dpr for creating a local hook, but this time it does not beep!
Instead it stores each key pressed in an array of bytes (20 long). Whenever
this array gets full, it writes it to a file, log.txt and starts again.
}
function GlobalKeyBoardHook(code: integer; wParam: word; lParam: longword): longword; stdcall;
begin
    if code<0 then begin  //if code is <0 your keyboard hook should always run CallNextHookEx instantly and
       GlobalKeyBoardHook:=CallNextHookEx(CurrentHook,code,wParam,lparam); //then return the value from it.
       Exit;
    end;
    //firstly, is the key being pressed, and is it between A and Z
    //note that wParam contains the scan code of the key (which for a-z is the same as the ascii value)
    if ((lParam and KF_UP)=0) and (wParam>=65) and (wParam<=90) then begin
         //store the keycode in the list of keys pressed and increase the pointer
         KeyArray[KeyArrayPtr]:=wParam;
         KeyArrayPtr:=KeyArrayPtr+1;
         //if 20 keys have been recorded, save them to log.txt and start again
         if KeyArrayPtr>19 then begin
            assignfile(CurFile,'log.txt');
            if fileexists('log.txt')=false then rewrite(CurFile) else reset(CurFile); //if log.txt exists, add to it, otherwise recreate it
            blockwrite(CurFile,KeyArray[0],20);
            closefile(CurFile);
            KeyArrayPtr:=0;
         end;
    end;
    CallNextHookEx(CurrentHook,code,wParam,lparam);  //call the next hook proc if there is one
    GlobalKeyBoardHook:=0; //if GlobalKeyBoardHook returns a non-zero value, the window that should get
                     //the keyboard message doesnt get it.
    Exit;
end;

{
SetHookHandle
-------------
This procedure is called by hooks.exe simply to 'inform' the dll of
the handle generated when creating the hook. This is required
if the hook procedure is to call CallNextHookEx. It also resets the
position in the key list to 0.

}
procedure SetHookHandle(HookHandle: HHook); stdcall;
begin
    CurrentHook:=HookHandle;
    KeyArrayPtr:=0;
end;

exports GlobalKeyBoardHook index 1,
        SetHookHandle index 2;
begin

end.

unit MainFormUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Local, global,
  StdCtrls;

type
  TMainForm = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

procedure TMainForm.Button1Click(Sender: TObject);
begin
    if GHookInstalled=true then exit; //if a global hook is installed, exit routine
     //if a local hook not installed, then attempt to install one, else attempt to remove one
     if HookInstalled=false then HookInstalled:=SetupLocalHook else HookInstalled:=not(RemoveLocalHook);
end;

procedure TMainForm.FormCreate(Sender: TObject);
begin
     HookInstalled:=false;
     GHookInstalled:=false;
     LibLoaded:=false;
end;

procedure TMainForm.FormDestroy(Sender: TObject);
begin
     if HookInstalled=true then RemoveLocalHook;
end;

procedure TMainForm.Button2Click(Sender: TObject);
begin
     if HookInstalled=true then exit; //if a local hook is installed, exit routine
     //if a local hook not installed, then attempt to install one, else attempt to remove one
     //note that removelocalhook can still be used no matter whether the hook is global or local
     if GHookInstalled=false then GHookInstalled:=SetupGlobalHook else GHookInstalled:=not(RemoveLocalHook);
end;

end.

Взято с Исходников.ru

Создание многомерного массива

Создание многомерного массива

type
PRow = ^TRow;
  TRow = array[0..16379] of Single;

  PMat = ^TMat;
  TMat = array[0..16379] of PRow;

var
  Mat: PMat;
  X, Y, Xmax, Ymax: Integer;

begin
  Write('Задайте размер массива: ');
  ReadLn(Xmax, Ymax);
  if (Xmax <= 0) or (Xmax > 16380) or (Ymax <= 0) or (Ymax > 16380) then
    begin
      WriteLn('Неверный диапазон. Не могу продолжить.');
      Exit;
    end;
  GetMem(Mat, Xmax * SizeOf(PRow));
  for X := 0 to Xmax - 1 do
    begin
      GetMem(Mat[X], Ymax * SizeOf(Single));
      for Y := 0 to Ymax - 1 do
        Mat^[X]^[Y] := 0.0;
    end;
  WriteLn('Масси инициализирован и готов к работе.');
  WriteLn('Но эта программа закончила свою работу.');
end.

- Steve Schafer

Взято из

Советов по Delphi от

Сборник Kuliba

Создание новой MS Access базы данных

Создание новой MS Access базы данных

Приведенная ниже процедура создает пустую базу данных MS Access


procedureCreateMSAccessDatabase(filename: string);
var DAO: Variant;
  i: integer;
const Engines: array[0..2] of string = ('DAO.DBEngine.36', 'DAO.DBEngine.35', 'DAO.DBEngine');

  function CheckClass(OLEClassName: string): boolean;
  var Res: HResult;
  begin
    Result := CoCreateInstance(ProgIDToClassID(OLEClassName), nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IDispatch, Res) = S_OK;
  end;
begin
  for i := 0 to 2 do
    if CheckClass(Engines[i]) then
      begin
        DAO := CreateOleObject(Engines[i]);
        DAO.Workspaces[0].CreateDatabase(filename, ';LANGID=0x0409;CP=1252;COUNTRY=0', 32);
        exit;
      end;
  raise Exception.Create('DAO engine could not be initialized');
end;


Кусочек кода, который должен распознавать какая версия DAO установлена на компьютере мной не мог быть оттестирован, так как только одна работающая версия DAO может быть установлена на компьютере. У меня установлен Office XP (DAO36) и на нем все работает нормально. Интересно было бы узнать работает ли логика для Office 2000 (DAO35) и Office 97 (DAO30)

Автор ответа: Vit
Взято с Vingrad.ru



Here is an OP function that will do it for you:

procedure CreateMSAccessDB(filename: string);
var
  DBEngine, Workspace: Variant;
const
  {Important to use the following constant as is}
  dbLangGeneral = '';
  LANGID = 0x0409;
  CP = 1252;
  COUNTRY = '0';
  dbVersion30 = 32;
begin
  DBEngine := CreateOleObject('DAO.DBEngine');
  {DBEngine := CreateOleObject('DAO.DBEngine.35'); For DAO 3.5}
  Workspace := DBEngine.Workspaces[0];
  try
    Workspace.CreateDatabase(filename, dbLangGeneral, dbVersion30);
  except
    on EOleException do
      ShowMessage('Database already exists');
  end;
end;

Взято с

Delphi Knowledge Base




It's very simple to create a empty Access-Database (*.mdb File) using OLE. It's not necessary to have MS-Access installed on your computer. If an exception occures the error message will returned. After creating the DB you can create Tables with simple SQL-Statements.

uses comobj, sysutils;

function CreateAccessDatabase(FileName: string): string;
var
  cat: OLEVariant;
begin
  result := '';
  try
    cat := CreateOleObject('ADOX.Catalog');
    cat.create('Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' + Filename + ';');
    cat := NULL;
  except
    on e: Exception do
      result := e.message;
  end;
end;

Взято с

Delphi Knowledge Base



const
CLASS_DBEngine: TGUID = '{00000100-0000-0010-8000-00AA006D2EA4}';
  dbLangCyrillic = ';LANGID=0x0409;CP=1252;COUNTRY=0';
  dbOption       =     0
//                  or $20 // ? похоже создание в формате Access 97
                ;

procedure CreateMSAccessDatabase(FileName :String);
begin
  Variant(CreateOleObject(ClassIDToProgID(CLASS_DBEngine)))
    .Workspaces[0]
      .CreateDatabase (FileName, dbLangCyrillic, dbOption);
end;

Автор:

Петрович

Взято из

Создание PolyPolygon используя массив точек?

Создание PolyPolygon используя массив точек?

Polygon - метод компонента TCanvas получает в качестве параметра динамический массив точек. Функция PolyPolygon() из Windows GDI получает указатель на массив точек.

procedure TForm1.Button1Click(Sender: TObject);
var
  ptArray: array[0..9] of TPOINT;
  PtCounts: array[0..1] of integer;
begin
  PtArray[0] := Point(0, 0);
  PtArray[1] := Point(0, 100);
  PtArray[2] := Point(100, 100);
  PtArray[3] := Point(100, 0);
  PtArray[4] := Point(0, 0);
  PtCounts[0] := 5;
  PtArray[5] := Point(25, 25);
  PtArray[6] := Point(25, 75);
  PtArray[7] := Point(75, 75);
  PtArray[8] := Point(75, 25);
  PtArray[9] := Point(25, 25);
  PtCounts[1] := 5;
  PolyPolygon(Form1.Canvas.Handle,PtArray, PtCounts, 2);
end;

Создание пустого wav-файла

Создание пустого wav-файла

Как мне создать пустой wav-файл? Это просто пустой двоичный файл?

The TMediaPlayer может открыть звуковой файл, если он содержит, по крайней мере, один байт данных. Я обнаружил это, когда с помощью данного компонента пытался создать и открыть звуковой файл, содержащий только заголовок звукового файла. The TMediaplayer не захотел этого делать.

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


functionCreateNewWave(NewFileName: string): Boolean;

var
  DeviceID: Word;
  Return: LongInt;
  MciOpen: TMCI_Open_Parms;
  MciRecord: TMCI_Record_Parms;
  MciPlay: TMCI_Play_Parms;
  MciSave: TMCI_SaveParms;
  MCIResult: LongInt;
  Flags: Word;
  TempFileName: array[0..255] of char;

begin
  MediaPlayer.Close;

  StrPCopy(TempFileName, NewFileName);
  MciOpen.lpstrDeviceType := 'waveaudio';
  MciOpen.lpstrElementName := '';
  Flags := Mci_Open_Element or Mci_Open_Type;
  MCIResult := MciSendCommand(0, MCI_OPEN, Flags, LongInt(@MciOpen));

  DeviceID := MciOpen.wDeviceId;

  MciRecord.dwTo := 1;
  Flags := Mci_To or Mci_Wait;
  MCIResult := MciSendCommand(DeviceID, Mci_Record, Flags, LongInt(@MciRecord));

  mciPlay.dwFrom := 0;
  Flags := Mci_From or Mci_Wait;
  MciSendCommand(DeviceId, Mci_Play, Flags, LongInt(@MciPlay));

  mciSave.lpfileName := TempFilename;
  Flags := MCI_Save_File or Mci_Wait;
  MCIResult := MciSendCommand(DeviceID, MCI_Save, Flags, LongInt(@MciSave));

  Result := MciSendCommand(DeviceID, Mci_Close, 0, LongInt(nil)) = 0;
end;


Как мне очистить содержимое Wav-файла? Просто заново создать пустой?
Вот небольшой компонент, позволяющий стирать любую часть wave-файла:


unit Nickmp;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, MPlayer, MMSystem;

type
  TNickMediaPlayer = class(TMediaPlayer)
  private
{ Private declarations }
  protected
{ Protected declarations }
  public
{ Public declarations }
    function DeleteWaveChunk(aFrom, aTo: LongInt): Longint;
  published
{ Published declarations }
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TNickMediaPlayer]);
end;

function TNickMediaPlayer.DeleteWaveChunk(aFrom, aTo: LongInt): Longint;
var
  DeleteParms: TMCI_WAVE_DELETE_PARMS;
  Flags: LongInt;
begin
  Flags := 0;

  if Wait then Flags := mci_Wait;
  if Notify then Flags := Flags or mci_Notify;
  DeleteParms.dwCallback := Handle;
  Flags := Flags or mci_From;
  DeleteParms.dwFrom := aFrom;
  Flags := Flags or mci_To;
  DeleteParms.dwTo := aTo;
  Result := mciSendCommand(DeviceID, mci_Delete, Flags, Longint(@DeleteParms));
end;

end.

- Nick Hodges

Взято из

Советов по Delphi от

Сборник Kuliba

Создание редактора свойства

Создание редактора свойства

Взято из FAQ:
Если вы присвоили свойству имя TableName, то полный цикл создания
редактора свойств включает следующие шаги:
Опишите класс редактора свойства:


type
TTableNameProperty = class(TStringProperty)  
function GetAttributes: TPropertyAttributes; override;  
procedure GetValues(Proc: TGetStrProc); override;  
end;

implementation

{ TTableNameProperty }
function TTableNameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paValueList];
end;

procedure TTableNameProperty.GetValues(Proc: TGetStrProc);
var  
TableName: String;  
I: Integer;  
begin
{ здесь вы должны добавить свой код, ?тобы с помощью цикла обойти имена всех  
таблиц, включенных в список }  
for I := 0 to ???? do   
begin  
TableName := ????[I];  
Proc(TableName);  
end;  
end; 

Затем зарегистрируйте данный редактор свойства следующим образом:

 RegisterPropertyEditor(TypeInfo(string), TcsNotebook, 'TableName', TTableNameProperty);    


Взято с Vingrad.ru

Создание таблицы

Создание таблицы

usesDB, DBTables, StdCtrls;

procedure TForm1.Button1Click(Sender: TObject);
var
  tSource, TDest: TTable;
begin
  TSource := TTable.create(self);
  with TSource do
  begin
    DatabaseName := 'dbdemos';
    TableName := 'customer.db';
    open;
  end;
  TDest := TTable.create(self);
  with TDest do
  begin
    DatabaseName := 'dbdemos';
    TableName := 'MyNewTbl.db';
    FieldDefs.Assign(TSource.FieldDefs);
    IndexDefs.Assign(TSource.IndexDefs);
    CreateTable;
  end;
  TSource.close;
end;


// Создание DBF-файла во время работы приложения

...
const
  CreateTab = 'CREATE TABLE ';
  IDXTab = 'PRIMARY KEY ';
  MyTabStruct =
    'IDX_TAB DECIMAL(6,0), ' +
    'DATE_ DATE, ' +
    'FLD_1 CHARACTER(20), ' +
    'FLD_2 DECIMAL(7,2), ' +
    'FLD_3 BOOLEAN, ' +
    'FLD_4 BLOB(1,1), ' +
    'FLD_5 BLOB(1,2), ' +
    'FLD_6 BLOB(1,3), ' +
    'FLD_7 BLOB(1,4), ' +
    'FLD_8 BLOB(1,5) ';
  ...

  // создание таблицы без индекса

procedure TForm1.Button1Click(Sender: TObject);
begin
  if CreateTable('"MYTAB.DBF"', MyTabStruct, '') then
    ...
      // выполняем дальнейшие операции
  else
    ...
end;

// создание таблицы с индексом

procedure TForm1.Button2Click(Sender: TObject);
begin
  if CreateTable('"MYTAB.DBF"', MyTabStruct, IDXTab + ' (IDX_TAB)') then
    ...
      // выполняем дальнейшие операции
  else
    ...
end;

function TForm1.CreateTable(TabName, TabStruct, TabIDX: string): boolean;
var
  qyTable: TQuery;
begin
  result := true;
  qyTable := TQuery.Create(Self);
  with qyTable do
  try
    try
      SQL.Clear;
      SQL.Add(CreateTab + TabName + '(' + TabStruct + TabIDX + ')');
      Prepare;
      // ExecSQL, а не Open. Иначе ... облом
      ExecSQL;
    except
      // Обработка ошибок открытия таблицы Возможности обработчика можно расширить.
      Exception.Create('Ошибка открытия таблицы');
      result := false;
    end;
  finally
    Close;
  end;
end;


sql := 'CREATE TABLE "employee.db" ( '+
       'Last_Name CHAR(20),'+
       'First_Name CHAR(15),'+ 
       'Salary NUMERIC(10,2),'+
       'Dept_No SMALLINT,'+ 
       'PRIMARY KEY (Last_Name, First_Name))';
Query1.sql.text:=sql;
Query1.ExecSQL;

Примечание Vit: этот способ наиболее предпочтительный, так как наиболее стандартный. Кроме того он будет работать практически неизменно на любых базах данных при использовании любого способа доступа, а не только BDE.

Взято из

Создание таблицы по образу и подобию

Создание таблицы по образу и подобию

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

var
Table2  : TTable;
begin
  Table1.FieldDefs.Update;
  Table1.IndexDefs.Update;
  Table2 := TTable.Create(nil);
  Table2.DatabaseName := Table1.DatabaseName;
  Table2.TableName := 'MyTable';
  Table2.TableType := Table1.TableType;
  Table2.FieldDefs.Assign(Table1.FieldDefs);
  Table2.IndexDefs.Assign(Table1.IndexDefs);
  Table2.CreateTable ;
end;


На ум сразу приходит операция присваивания значения свойству (стоящему с левой стороны от ':='), при которой Delphi в своих недрах вызывает метод 'write' и передает ему в виде единственного параметра все то, что находится в правой части выражения. Если свойство не имеет метода write, оно предназначено только для чтения. Вот определение свойства FieldDefs объекта TDataSet в файле DB.PAS:

property FieldDefs: TFieldDefs read FFieldDefs write SetFieldDefs;

Как вы можете видеть, у него есть метод write. Следовательно, код:

Destination.FieldDefs := Source.FieldDefs;

в действительности делает такую операцию:

Destination.SetFieldDefs(Source.FieldDefs);

(за исключением того, что вы не можете использовать эту строку, поскольку SetFieldDefs определен в секции Private.)

Вот определение свойства IndexDefs объекта TTable в файле DBTABLES.PAS file:

property IndexDefs: TIndexDefs read FIndexDefs;

В этом случае метод write отсутствует, поэтому свойство имеет атрибут только для чтения. Тем не менее, для самого объекта TIndexDefs существует метод Assign. Следовательно, следующий код должен работать:

Source.IndexDefs.Update;
Destination.IndexDefs.Assign(Source.IndexDefs); 

Перед вызовом Assign для Source.IndexDefs вызывайте метод Update, чтобы быть уверенным в том, что вы получите то, что хотите.

Метод SetFieldDefs является процедурой с одной строкой кода, в которой вызывается метод FieldDefs Assign.

Также можно проверить, определен ли реально индекс, и, если нет, то при вызове IndexDefs.Assign вы можете получить исключение типа "List Index Out Of Bounds" (или что-то типа этого). Например, так:

if Source.IndexDefs.Count > 0 then... 

Вам нужно будет это сделать, поскольку метод TIndexDefs.Assign не проверяет это перед копированием индекс-информации. Также вам нет необходимости вызывать Clear до работы с IndexDefs, поскольку метод Assign сделает это и без вашего участия.

Взято из

Создание таблицы с автоинкрементальным полем

Создание таблицы с автоинкрементальным полем

Допустим у вас имеется форма с кнопкой. Щелчок на кнопке с помощью DbiCreateTable должен создать таблицу Paradox с автоинкрементальным (приращиваемым) полем.

unitAutoinc;

interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, DBTables, DB, ExtCtrls, DBCtrls, Grids, DBGrids, StdCtrls,
  DbiTypes, DbiErrs, DBIProcs;

const
  szTblName = 'CR8PXTBL'; { Имя создаваемой таблицы. }
  szTblType = szPARADOX; { Используемый тип таблицы. }

  { При создании таблицы используется полное описание поля }
const
  fldDes: array[0..1] of FLDDesc = (
    ({ Поле 1 - AUTOINC }
    iFldNum: 1; { Номер поля }
    szName: 'AUTOINC'; { Имя поля }
    iFldType: fldINT32; { Тип поля }
    iSubType: fldstAUTOINC; { Подтип поля }
    iUnits1: 0; { Размер поля }
    iUnits2: 0; { Десятичный порядок следования ( 0 ) }
    iOffset: 0; { Смещение в записи     ( 0 ) }
    iLen: 0; { Длина в байтах        ( 0 ) }
    iNullOffset: 0; { Для Null-битов        ( 0 ) }
    efldvVchk: fldvNOCHECKS; { Проверка корректности ( 0 ) }
    efldrRights: fldrREADWRITE { Права }
    ),
    ({ Поле 2 - ALPHA }
    iFldNum: 2; szName: 'ALPHA';
    iFldType: fldZSTRING; iSubType: fldUNKNOWN;
    iUnits1: 10; iUnits2: 0;
    iOffset: 0; iLen: 0;
    iNullOffset: 0; efldvVchk: fldvNOCHECKS;
    efldrRights: fldrREADWRITE
    ));

type
  TForm1 = class(TForm)
    Button1: TButton;
    Database1: TDatabase;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
var
  TblDesc: CRTblDesc;
  uNumFields: Integer;
  Rslt: DbiResult;
  ErrorString: array[0..dbiMaxMsgLen] of Char;
begin
  FillChar(TblDesc, sizeof(CRTblDesc), #0);
  lStrCpy(TblDesc.szTblName, szTblName);
  lStrCpy(TblDesc.szTblType, szTblType);
  uNumFields := trunc(sizeof(fldDes) / sizeof(fldDes[0]));
  TblDesc.iFldCount := uNumFields;
  TblDesc.pfldDesc := @fldDes;

  Rslt := DbiCreateTable(Database1.Handle, TRUE, TblDesc);
  if Rslt <> dbiErr_None then
  begin
    DbiGetErrorString(Rslt, ErrorString);
    MessageDlg(StrPas(ErrorString), mtWarning, [mbOk], 0);
  end;
end;

end.

Взято из

Создание UDF для InterBase

Создание UDF для InterBase

librarynikelutils

uses SysUtils, Classes;

function MaxInt(var Int1, Int2: Integer): Integer;
  far cdecl export;
begin
  if (Int1 > Int2) then
    Result := Int1
  else
    Result := Int2;
end;

function MinInt(var Int1, Int2: Integer): Integer;
  far cdecl export;
begin
  if (Int1 < Int2) then
    Result := Int1
  else
    Result := Int2;
end;

exports
  MaxInt;
MinInt;

begin
end.




А это пишим в базе:



DECLARE EXTERNAL FUNCTION MAXINT INTEGER, INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT "MaxInt" MODULE_NAME "nikelutils.dll";

DECLARE EXTERNAL FUNCTION MININT INTEGER, INTEGER
RETURNS INTEGER BY VALUE
ENTRY_POINT "MinInt" MODULE_NAME "nikelutils.dll";

Взято из

Создание Web приложений

Создание Web приложений

Cодержание раздела:

·
·  

·

·  
·  
·  
·  









См. также статьи в других разделах:

Создание, закрытие и вызов форм

Создание, закрытие и вызов форм

Cодержание раздела:

Создание заставки при старте программы

Создание заставки при старте программы

Перед появлением главного окна во всех серьёзных приложениях сначала появляется заставка. Теперь и у Вас есть возможность повыёживаться! Для создания заставки выполняем следующую последовательность действий:

Начинаем создание нового приложение командой "New Application" ("Новое приложение") из меню "File" ("Файл")

Добавьте ещё одну форму: "New Form"("Новая форма") из меню "File" ("Файл"). Это окно и будет заставкой. У него нужно убрать рамку с полосой заголовка, установив свойство "BorderStyle" в "bsNone". Теперь можно смело разработать дизайн окна заставки.

Из меню "Project" ("Проект") выбрать команду "Options"("Опции"). Зайти на закладку "Forms"("Формы") и Form2 из списка автоматически создаваемых форм (Auto-Create forms) перенести в список доступных форм (Available forms)

На форму-заставку с закладки System вынести компонент Timer. В его свойстве Interval установить значение 5000, а в событии OnTimer написать:



Timer1.Enabled:= false;




Это сделано для того, чтобы заставка была видна в период указанного времени ? 5000 миллисекунд, т.е. 5 секунд.

Перейти в файл проекта, нажав Ctrl+F12 и выбрав Project1. Исходный код должен выглядеть так:



program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

 


Теперь мы внесём сюда немного изменений и код должен стать таким:



program Project1;

uses
  Forms,
  Unit1 in 'Unit1.pas' {Form1},
  Unit2 in 'Unit2.pas' {Form2};

{$R *.RES}

begin
  Application.Initialize;
  Form2 := TForm2.Create(Application);
  Form2.Show;
  Form2.Update;
  while Form2.Timer1.Enabled do
    Application.ProcessMessages;
  Application.CreateForm(TForm1, Form1);
  Form2.Hide;
  Form2.Free;
  Application.Run;
end.

Взято с

Список ошибок BDE

Список ошибок BDE

$0000 (0) = Successful completion. 
$0021 (33) = System Error 
$0022 (34) = Object of Interest Not Found 
$0023 (35) = Physical Data Corruption 
$0024 (36) = I/O Related Error 
$0025 (37) = Resource or Limit Error 
$0026 (38) = Data Integrity Violation 
$0027 (39) = Invalid Request 
$0028 (40) = Lock Violation 
$0029 (41) = Access/Security Violation 
$002A (42) = Invalid Context 
$002B (43) = OS Error 
$002C (44) = Network Error 
$002D (45) = Optional Parameter 
$002E (46) = Query Processor 
$002F (47) = Version Mismatch 
$0030 (48) = Capability Not Supported 
$0031 (49) = System Configuration Error 
$0032 (50) = Warning 
$0033 (51) = Miscellaneous 
$0034 (52) = Compatibility Error 
$003E (62) = Driver Specific Error 
$003F (63) = Internal Symbol 
$2101 (8449) = Cannot open a system file. 
$2102 (8450) = I/O error on a system file. 
$2103 (8451) = Data structure corruption. 
$2104 (8452) = Cannot find Engine configuration file. 
$2105 (8453) = Cannot write to Engine configuration file. 
$2106 (8454) = Cannot initialize with different configuration file. 
$2107 (8455) = System has been illegally re-entered. 
$2108 (8456) = Cannot locate IDAPI32 .DLL. 
$2109 (8457) = Cannot load IDAPI32 .DLL. 
$210A (8458) = Cannot load an IDAPI service library. 
$210B (8459) = Cannot create or open temporary file. 
$2201 (8705) = At beginning of table. 
$2202 (8706) = At end of table. 
$2203 (8707) = Record moved because key value changed. 
$2204 (8708) = Record/Key deleted. 
$2205 (8709) = No current record. 
$2206 (8710) = Could not find record. 
$2207 (8711) = End of BLOB. 
$2208 (8712) = Could not find object. 
$2209 (8713) = Could not find family member. 
$220A (8714) = BLOB file is missing. 
$220B (8715) = Could not find language driver. 
$2301 (8961) = Corrupt table/index header. 
$2302 (8962) = Corrupt file - other than header. 
$2303 (8963) = Corrupt Memo/BLOB file. 
$2305 (8965) = Corrupt index. 
$2306 (8966) = Corrupt lock file. 
$2307 (8967) = Corrupt family file. 
$2308 (8968) = Corrupt or missing .VAL file. 
$2309 (8969) = Foreign index file format. 
$2401 (9217) = Read failure. 
$2402 (9218) = Write failure. 
$2403 (9219) = Cannot access directory. 
$2404 (9220) = File Delete operation failed. 
$2405 (9221) = Cannot access file. 
$2406 (9222) = Access to table disabled because of previous error. 
$2501 (9473) = Insufficient memory for this operation. 
$2502 (9474) = Not enough file handles. 
$2503 (9475) = Insufficient disk space. 
$2504 (9476) = Temporary table resource limit. 
$2505 (9477) = Record size is too big for table. 
$2506 (9478) = Too many open cursors. 
$2507 (9479) = Table is full. 
$2508 (9480) = Too many sessions from this workstation. 
$2509 (9481) = Serial number limit (Paradox). 
$250A (9482) = Some internal limit (see context). 
$250B (9483) = Too many open tables. 
$250C (9484) = Too many cursors per table. 
$250D (9485) = Too many record locks on table. 
$250E (9486) = Too many clients. 
$250F (9487) = Too many indexes on table. 
$2510 (9488) = Too many sessions. 
$2511 (9489) = Too many open databases. 
$2512 (9490) = Too many passwords. 
$2513 (9491) = Too many active drivers. 
$2514 (9492) = Too many fields in Table Create. 
$2515 (9493) = Too many table locks. 
$2516 (9494) = Too many open BLOBs. 
$2517 (9495) = Lock file has grown too large. 
$2518 (9496) = Too many open queries. 
$251A (9498) = Too many BLOBs. 
$251B (9499) = File name is too long for a Paradox version 5.0 table. 
$251C (9500) = Row fetch limit exceeded. 
$251D (9501) = Long name not allowed for this tablelevel. 
$2601 (9729) = Key violation. 
$2602 (9730) = Minimum validity check failed. 
$2603 (9731) = Maximum validity check failed. 
$2604 (9732) = Field value required. 
$2605 (9733) = Master record missing. 
$2606 (9734) = Master has detail records. Cannot delete or modify. 
$2607 (9735) = Master table level is incorrect. 
$2608 (9736) = Field value out of lookup table range. 
$2609 (9737) = Lookup Table Open operation failed. 
$260A (9738) = Detail Table Open operation failed. 
$260B (9739) = Master Table Open operation failed. 
$260C (9740) = Field is blank. 
$260D (9741) = Link to master table already defined. 
$260E (9742) = Master table is open. 
$260F (9743) = Detail table(s) exist. 
$2610 (9744) = Master has detail records. Cannot empty it. 
$2611 (9745) = Self referencing referential integrity must be entered one at a time with no other changes to the table 
$2612 (9746) = Detail table is open. 
$2613 (9747) = Cannot make this master a detail of another table if its details are not empty. 
$2614 (9748) = Referential integrity fields must be indexed. 
$2615 (9749) = A table linked by referential integrity requires password to open. 
$2616 (9750) = Field(s) linked to more than one master. 
$2617 (9751) = Expression validity check failed. 
$2701 (9985) = Number is out of range. 
$2702 (9986) = Invalid parameter. 
$2703 (9987) = Invalid file name. 
$2704 (9988) = File does not exist. 
$2705 (9989) = Invalid option. 
$2706 (9990) = Invalid handle to the function. 
$2707 (9991) = Unknown table type. 
$2708 (9992) = Cannot open file. 
$2709 (9993) = Cannot redefine primary key. 
$270A (9994) = Cannot change this RINTDesc. 
$270B (9995) = Foreign and primary key do not match. 
$270C (9996) = Invalid modify request. 
$270D (9997) = Index does not exist. 
$270E (9998) = Invalid offset into the BLOB. 
$270F (9999) = Invalid descriptor number. 
$2710 (10000) = Invalid field type. 
$2711 (10001) = Invalid field descriptor. 
$2712 (10002) = Invalid field transformation. 
$2713 (10003) = Invalid record structure. 
$2714 (10004) = Invalid descriptor. 
$2715 (10005) = Invalid array of index descriptors. 
$2716 (10006) = Invalid array of validity check descriptors. 
$2717 (10007) = Invalid array of referential integrity descriptors. 
$2718 (10008) = Invalid ordering of tables during restructure. 
$2719 (10009) = Name not unique in this context. 
$271A (10010) = Index name required. 
$271B (10011) = Invalid session handle. 
$271C (10012) = invalid restructure operation. 
$271D (10013) = Driver not known to system. 
$271E (10014) = Unknown database. 
$271F (10015) = Invalid password given. 
$2720 (10016) = No callback function. 
$2721 (10017) = Invalid callback buffer length. 
$2722 (10018) = Invalid directory. 
$2723 (10019) = Translate Error. Value out of bounds. 
$2724 (10020) = Cannot set cursor of one table to another. 
$2725 (10021) = Bookmarks do not match table. 
$2726 (10022) = Invalid index/tag name. 
$2727 (10023) = Invalid index descriptor. 
$2728 (10024) = Table does not exist. 
$2729 (10025) = Table has too many users. 
$272A (10026) = Cannot evaluate Key or Key does not pass filter condition. 
$272B (10027) = Index already exists. 
$272C (10028) = Index is open. 
$272D (10029) = Invalid BLOB length. 
$272E (10030) = Invalid BLOB handle in record buffer. 
$272F (10031) = Table is open. 
$2730 (10032) = Need to do (hard) restructure. 
$2731 (10033) = Invalid mode. 
$2732 (10034) = Cannot close index. 
$2733 (10035) = Index is being used to order table. 
$2734 (10036) = Unknown user name or password. 
$2735 (10037) = Multi-level cascade is not supported. 
$2736 (10038) = Invalid field name. 
$2737 (10039) = Invalid table name. 
$2738 (10040) = Invalid linked cursor expression. 
$2739 (10041) = Name is reserved. 
$273A (10042) = Invalid file extension. 
$273B (10043) = Invalid language Driver. 
$273C (10044) = Alias is not currently opened. 
$273D (10045) = Incompatible record structures. 
$273E (10046) = Name is reserved by DOS. 
$273F (10047) = Destination must be indexed. 
$2740 (10048) = Invalid index type 
$2741 (10049) = Language Drivers of Table and Index do not match 
$2742 (10050) = Filter handle is invalid 
$2743 (10051) = Invalid Filter 
$2744 (10052) = Invalid table create request 
$2745 (10053) = Invalid table delete request 
$2746 (10054) = Invalid index create request 
$2747 (10055) = Invalid index delete request 
$2748 (10056) = Invalid table specified 
$274A (10058) = Invalid Time. 
$274B (10059) = Invalid Date. 
$274C (10060) = Invalid Datetime 
$274D (10061) = Tables in different directories 
$274E (10062) = Mismatch in the number of arguments 
$274F (10063) = Function not found in service library. 
$2750 (10064) = Must use baseorder for this operation. 
$2751 (10065) = Invalid procedure name 
$2752 (10066) = The field map is invalid. 
$2801 (10241) = Record locked by another user. 
$2802 (10242) = Unlock failed. 
$2803 (10243) = Table is busy. 
$2804 (10244) = Directory is busy. 
$2805 (10245) = File is locked. 
$2806 (10246) = Directory is locked. 
$2807 (10247) = Record already locked by this session. 
$2808 (10248) = Object not locked. 
$2809 (10249) = Lock time out. 
$280A (10250) = Key group is locked. 
$280B (10251) = Table lock was lost. 
$280C (10252) = Exclusive access was lost. 
$280D (10253) = Table cannot be opened for exclusive use. 
$280E (10254) = Conflicting record lock in this session. 
$280F (10255) = A deadlock was detected. 
$2810 (10256) = A user transaction is already in progress. 
$2811 (10257) = No user transaction is currently in progress. 
$2812 (10258) = Record lock failed. 
$2813 (10259) = Couldn't perform the edit because another user changed the record. 
$2814 (10260) = Couldn't perform the edit because another user deleted or moved the record. 
$2901 (10497) = Insufficient field rights for operation. 
$2902 (10498) = Insufficient table rights for operation. Password required. 
$2903 (10499) = Insufficient family rights for operation. 
$2904 (10500) = This directory is read only. 
$2905 (10501) = Database is read only. 
$2906 (10502) = Trying to modify read-only field. 
$2907 (10503) = Encrypted dBASE tables not supported. 
$2908 (10504) = Insufficient SQL rights for operation. 
$2A01 (10753) = Field is not a BLOB. 
$2A02 (10754) = BLOB already opened. 
$2A03 (10755) = BLOB not opened. 
$2A04 (10756) = Operation not applicable. 
$2A05 (10757) = Table is not indexed. 
$2A06 (10758) = Engine not initialized. 
$2A07 (10759) = Attempt to re-initialize Engine. 
$2A08 (10760) = Attempt to mix objects from different sessions. 
$2A09 (10761) = Paradox driver not active. 
$2A0A (10762) = Driver not loaded. 
$2A0B (10763) = Table is read only. 
$2A0C (10764) = No associated index. 
$2A0D (10765) = Table(s) open. Cannot perform this operation. 
$2A0E (10766) = Table does not support this operation. 
$2A0F (10767) = Index is read only. 
$2A10 (10768) = Table does not support this operation because it is not uniquely indexed. 
$2A11 (10769) = Operation must be performed on the current session. 
$2A12 (10770) = Invalid use of keyword. 
$2A13 (10771) = Connection is in use by another statement. 
$2A14 (10772) = Passthrough SQL connection must be shared 
$2B01 (11009) = Invalid function number. 
$2B02 (11010) = File or directory does not exist. 
$2B03 (11011) = Path not found. 
$2B04 (11012) = Too many open files. You may need to increase MAXFILEHANDLE limit in IDAPI configuration. 
$2B05 (11013) = Permission denied. 
$2B06 (11014) = Bad file number. 
$2B07 (11015) = Memory blocks destroyed. 
$2B08 (11016) = Not enough memory. 
$2B09 (11017) = Invalid memory block address. 
$2B0A (11018) = Invalid environment. 
$2B0B (11019) = Invalid format. 
$2B0C (11020) = Invalid access code. 
$2B0D (11021) = Invalid data. 
$2B0F (11023) = Device does not exist. 
$2B10 (11024) = Attempt to remove current directory. 
$2B11 (11025) = Not same device. 
$2B12 (11026) = No more files. 
$2B13 (11027) = Invalid argument. 
$2B14 (11028) = Argument list is too long. 
$2B15 (11029) = Execution format error. 
$2B16 (11030) = Cross-device link. 
$2B21 (11041) = Math argument. 
$2B22 (11042) = Result is too large. 
$2B23 (11043) = File already exists. 
$2B27 (11047) = Unknown internal operating system error. 
$2B32 (11058) = Share violation. 
$2B33 (11059) = Lock violation. 
$2B34 (11060) = Critical DOS Error. 
$2B35 (11061) = Drive not ready. 
$2B64 (11108) = Not exact read/write. 
$2B65 (11109) = Operating system network error. 
$2B66 (11110) = Error from NOVELL file server. 
$2B67 (11111) = NOVELL server out of memory. 
$2B68 (11112) = Record already locked by this workstation. 
$2B69 (11113) = Record not locked. 
$2C01 (11265) = Network initialization failed. 
$2C02 (11266) = Network user limit exceeded. 
$2C03 (11267) = Wrong .NET file version. 
$2C04 (11268) = Cannot lock network file. 
$2C05 (11269) = Directory is not private. 
$2C06 (11270) = Directory is controlled by other .NET file. 
$2C07 (11271) = Unknown network error. 
$2C08 (11272) = Not initialized for accessing network files. 
$2C09 (11273) = SHARE not loaded. It is required to share local files. 
$2C0A (11274) = Not on a network. Not logged in or wrong network driver. 
$2C0B (11275) = Lost communication with SQL server. 
$2C0D (11277) = Cannot locate or connect to SQL server. 
$2C0E (11278) = Cannot locate or connect to network server. 
$2D01 (11521) = Optional parameter is required. 
$2D02 (11522) = Invalid optional parameter. 
$2E01 (11777) = obsolete 
$2E02 (11778) = obsolete 
$2E03 (11779) = Ambiguous use of ! (inclusion operator). 
$2E04 (11780) = obsolete 
$2E05 (11781) = obsolete 
$2E06 (11782) = A SET operation cannot be included in its own grouping. 
$2E07 (11783) = Only numeric and date/time fields can be averaged. 
$2E08 (11784) = Invalid expression. 
$2E09 (11785) = Invalid OR expression. 
$2E0A (11786) = obsolete 
$2E0B (11787) = bitmap 
$2E0C (11788) = CALC expression cannot be used in INSERT, DELETE, CHANGETO and SET rows. 
$2E0D (11789) = Type error in CALC expression. 
$2E0E (11790) = CHANGETO can be used in only one query form at a time. 
$2E0F (11791) = Cannot modify CHANGED table. 
$2E10 (11792) = A field can contain only one CHANGETO expression. 
$2E11 (11793) = A field cannot contain more than one expression to be inserted. 
$2E12 (11794) = obsolete 
$2E13 (11795) = CHANGETO must be followed by the new value for the field. 
$2E14 (11796) = Checkmark or CALC expressions cannot be used in FIND queries. 
$2E15 (11797) = Cannot perform operation on CHANGED table together with a CHANGETO query. 
$2E16 (11798) = chunk 
$2E17 (11799) = More than 255 fields in ANSWER table. 
$2E18 (11800) = AS must be followed by the name for the field in the ANSWER table. 
$2E19 (11801) = DELETE can be used in only one query form at a time. 
$2E1A (11802) = Cannot perform operation on DELETED table together with a DELETE query. 
$2E1B (11803) = Cannot delete from the DELETED table. 
$2E1C (11804) = Example element is used in two fields with incompatible types or with a BLOB. 
$2E1D (11805) = Cannot use example elements in an OR expression. 
$2E1E (11806) = Expression in this field has the wrong type. 
$2E1F (11807) = Extra comma found. 
$2E20 (11808) = Extra OR found. 
$2E21 (11809) = One or more query rows do not contribute to the ANSWER. 
$2E22 (11810) = FIND can be used in only one query form at a time. 
$2E23 (11811) = FIND cannot be used with the ANSWER table. 
$2E24 (11812) = A row with GROUPBY must contain SET operations. 
$2E25 (11813) = GROUPBY can be used only in SET rows. 
$2E26 (11814) = Use only INSERT, DELETE, SET or FIND in leftmost column. 
$2E27 (11815) = Use only one INSERT, DELETE, SET or FIND per line. 
$2E28 (11816) = Syntax error in expression. 
$2E29 (11817) = INSERT can be used in only one query form at a time. 
$2E2A (11818) = Cannot perform operation on INSERTED table together with an INSERT query. 
$2E2B (11819) = INSERT, DELETE, CHANGETO and SET rows may not be checked. 
$2E2C (11820) = Field must contain an expression to insert (or be blank). 
$2E2D (11821) = Cannot insert into the INSERTED table. 
$2E2E (11822) = Variable is an array and cannot be accessed. 
$2E2F (11823) = Label 
$2E30 (11824) = Rows of example elements in CALC expression must be linked. 
$2E31 (11825) = Variable name is too long. 
$2E32 (11826) = Query may take a long time to process. 
$2E33 (11827) = Reserved word or one that can't be used as a variable name. 
$2E34 (11828) = Missing comma. 
$2E35 (11829) = Missing ). 
$2E36 (11830) = Missing right quote. 
$2E37 (11831) = Cannot specify duplicate column names. 
$2E38 (11832) = Query has no checked fields. 
$2E39 (11833) = Example element has no defining occurrence. 
$2E3A (11834) = No grouping is defined for SET operation. 
$2E3B (11835) = Query makes no sense. 
$2E3C (11836) = Cannot use patterns in this context. 
$2E3D (11837) = Date does not exist. 
$2E3E (11838) = Variable has not been assigned a value. 
$2E3F (11839) = Invalid use of example element in summary expression. 
$2E40 (11840) = Incomplete query statement. Query only contains a SET definition. 
$2E41 (11841) = Example element with ! makes no sense in expression. 
$2E42 (11842) = Example element cannot be used more than twice with a ! query. 
$2E43 (11843) = Row cannot contain expression. 
$2E44 (11844) = obsolete 
$2E45 (11845) = obsolete 
$2E46 (11846) = No permission to insert or delete records. 
$2E47 (11847) = No permission to modify field. 
$2E48 (11848) = Field not found in table. 
$2E49 (11849) = Expecting a column separator in table header. 
$2E4A (11850) = Expecting a column separator in table. 
$2E4B (11851) = Expecting column name in table. 
$2E4C (11852) = Expecting table name. 
$2E4D (11853) = Expecting consistent number of columns in all rows of table. 
$2E4E (11854) = Cannot open table. 
$2E4F (11855) = Field appears more than once in table. 
$2E50 (11856) = This DELETE, CHANGE or INSERT query has no ANSWER. 
$2E51 (11857) = Query is not prepared. Properties unknown. 
$2E52 (11858) = DELETE rows cannot contain quantifier expression. 
$2E53 (11859) = Invalid expression in INSERT row. 
$2E54 (11860) = Invalid expression in INSERT row. 
$2E55 (11861) = Invalid expression in SET definition. 
$2E56 (11862) = row use 
$2E57 (11863) = SET keyword expected. 
$2E58 (11864) = Ambiguous use of example element. 
$2E59 (11865) = obsolete 
$2E5A (11866) = obsolete 
$2E5B (11867) = Only numeric fields can be summed. 
$2E5C (11868) = Table is write protected. 
$2E5D (11869) = Token not found. 
$2E5E (11870) = Cannot use example element with ! more than once in a single row. 
$2E5F (11871) = Type mismatch in expression. 
$2E60 (11872) = Query appears to ask two unrelated questions. 
$2E61 (11873) = Unused SET row. 
$2E62 (11874) = INSERT, DELETE, FIND, and SET can be used only in the leftmost column. 
$2E63 (11875) = CHANGETO cannot be used with INSERT, DELETE, SET or FIND. 
$2E64 (11876) = Expression must be followed by an example element defined in a SET. 
$2E65 (11877) = Lock failure. 
$2E66 (11878) = Expression is too long. 
$2E67 (11879) = Refresh exception during query. 
$2E68 (11880) = Query canceled. 
$2E69 (11881) = Unexpected Database Engine error. 
$2E6A (11882) = Not enough memory to finish operation. 
$2E6B (11883) = Unexpected exception. 
$2E6C (11884) = Feature not implemented yet in query. 
$2E6D (11885) = Query format is not supported. 
$2E6E (11886) = Query string is empty. 
$2E6F (11887) = Attempted to prepare an empty query. 
$2E70 (11888) = Buffer too small to contain query string. 
$2E71 (11889) = Query was not previously parsed or prepared. 
$2E72 (11890) = Function called with bad query handle. 
$2E73 (11891) = QBE syntax error. 
$2E74 (11892) = Query extended syntax field count error. 
$2E75 (11893) = Field name in sort or field clause not found. 
$2E76 (11894) = Table name in sort or field clause not found. 
$2E77 (11895) = Operation is not supported on BLOB fields. 
$2E78 (11896) = General BLOB error. 
$2E79 (11897) = Query must be restarted. 
$2E7A (11898) = Unknown answer table type. 
$2E96 (11926) = Blob cannot be used as grouping field. 
$2E97 (11927) = Query properties have not been fetched. 
$2E98 (11928) = Answer table is of unsuitable type. 
$2E99 (11929) = Answer table is not yet supported under server alias. 
$2E9A (11930) = Non-null blob field required. Can't insert records 
$2E9B (11931) = Unique index required to perform changeto 
$2E9C (11932) = Unique index required to delete records 
$2E9D (11933) = Update of table on the server failed. 
$2E9E (11934) = Can't process this query remotely. 
$2E9F (11935) = Unexpected end of command. 
$2EA0 (11936) = Parameter not set in query string. 
$2EA1 (11937) = Query string is too long. 
$2EAA (11946) = No such table or correlation name. 
$2EAB (11947) = Expression has ambiguous data type. 
$2EAC (11948) = Field in order by must be in result set. 
$2EAD (11949) = General parsing error. 
$2EAE (11950) = Record or field constraint failed. 
$2EAF (11951) = When GROUP BY exists, every simple field in projectors must be in GROUP BY. 
$2EB0 (11952) = User defined function is not defined. 
$2EB1 (11953) = Unknown error from User defined function. 
$2EB2 (11954) = Single row subquery produced more than one row. 
$2EB3 (11955) = Expressions in group by are not supported. 
$2EB4 (11956) = Queries on text or ascii tables is not supported. 
$2EB5 (11957) = ANSI join keywords USING and NATURAL are not supported in this release. 
$2EB6 (11958) = SELECT DISTINCT may not be used with UNION unless UNION ALL is used. 
$2EB7 (11959) = GROUP BY is required when both aggregate and non-aggregate fields are used in result set. 
$2EB8 (11960) = INSERT and UPDATE operations are not supported on autoincrement field type. 
$2EB9 (11961) = UPDATE on Primary Key of a Master Table may modify more than one record. 
$2EBA (11962) = Queries on MS ACCESS tables are not supported by local query engines. 
$2EBB (11963) = Preparation of field-level constraint failed. 
$2EBC (11964) = Preparation of field default failed. 
$2EBD (11965) = Preparation of record-level constraint failed. 
$2EC4 (11972) = Constraint Failed. Expression: 
$2F01 (12033) = Interface mismatch. Engine version different. 
$2F02 (12034) = Index is out of date. 
$2F03 (12035) = Older version (see context). 
$2F04 (12036) = .VAL file is out of date. 
$2F05 (12037) = BLOB file version is too old. 
$2F06 (12038) = Query and Engine DLLs are mismatched. 
$2F07 (12039) = Server is incompatible version. 
$2F08 (12040) = Higher table level required 
$3001 (12289) = Capability not supported. 
$3002 (12290) = Not implemented yet. 
$3003 (12291) = SQL replicas not supported. 
$3004 (12292) = Non-blob column in table required to perform operation. 
$3005 (12293) = Multiple connections not supported. 
$3006 (12294) = Full dBASE expressions not supported. 
$3101 (12545) = Invalid database alias specification. 
$3102 (12546) = Unknown database type. 
$3103 (12547) = Corrupt system configuration file. 
$3104 (12548) = Network type unknown. 
$3105 (12549) = Not on the network. 
$3106 (12550) = Invalid configuration parameter. 
$3201 (12801) = Object implicitly dropped. 
$3202 (12802) = Object may be truncated. 
$3203 (12803) = Object implicitly modified. 
$3204 (12804) = Should field constraints be checked? 
$3205 (12805) = Validity check field modified. 
$3206 (12806) = Table level changed. 
$3207 (12807) = Copy linked tables? 
$3209 (12809) = Object implicitly truncated. 
$320A (12810) = Validity check will not be enforced. 
$320B (12811) = Multiple records found, but only one was expected. 
$320C (12812) = Field will be trimmed, cannot put master records into PROBLEM table. 
$3301 (13057) = File already exists. 
$3302 (13058) = BLOB has been modified. 
$3303 (13059) = General SQL error. 
$3304 (13060) = Table already exists. 
$3305 (13061) = Paradox 1.0 tables are not supported. 
$3306 (13062) = Update aborted. 
$3401 (13313) = Different sort order. 
$3402 (13314) = Directory in use by earlier version of Paradox. 
$3403 (13315) = Needs Paradox 3.5-compatible language driver. 
$3501 (13569) = Data Dictionary is corrupt 
$3502 (13570) = Data Dictionary Info Blob corrupted 
$3503 (13571) = Data Dictionary Schema is corrupt 
$3504 (13572) = Attribute Type exists 
$3505 (13573) = Invalid Object Type 
$3506 (13574) = Invalid Relation Type 
$3507 (13575) = View already exists 
$3508 (13576) = No such View exists 
$3509 (13577) = Invalid Record Constraint 
$350A (13578) = Object is in a Logical DB 
$350B (13579) = Dictionary already exists 
$350C (13580) = Dictionary does not exist 
$350D (13581) = Dictionary database does not exist 
$350E (13582) = Dictionary info is out of date - needs Refresh 
$3510 (13584) = Invalid Dictionary Name 
$3511 (13585) = Dependent Objects exist 
$3512 (13586) = Too many Relationships for this Object Type 
$3513 (13587) = Relationships to the Object exist 
$3514 (13588) = Dictionary Exchange File is corrupt 
$3515 (13589) = Dictionary Exchange File Version mismatch 
$3516 (13590) = Dictionary Object Type Mismatch 
$3517 (13591) = Object exists in Target Dictionary 
$3518 (13592) = Cannot access Data Dictionary 
$3519 (13593) = Cannot create Data Dictionary 
$351A (13594) = Cannot open Database 
$3E01 (15873) = Wrong driver name. 
$3E02 (15874) = Wrong system version. 
$3E03 (15875) = Wrong driver version. 
$3E04 (15876) = Wrong driver type. 
$3E05 (15877) = Cannot load driver. 
$3E06 (15878) = Cannot load language driver. 
$3E07 (15879) = Vendor initialization failed. 
$3E08 (15880) = Your application is not enabled for use with this driver. 
$3F01 (16129) = Query By Example 
$3F02 (16130) = SQL Generator 
$3F03 (16131) = IDAPI 
$3F04 (16132) = Lock Manager 
$3F05 (16133) = SQL Driver 
$3F06 (16134) = IDAPI Services 
$3F07 (16135) = dBASE Driver 
$3F08 (16136) = Dictionary Manager 
$3F0B (16139) = Token 
$3F0D (16141) = Table 
$3F0E (16142) = Field 
$3F0F (16143) = Image 
$3F10 (16144) = User 
$3F11 (16145) = File 
$3F12 (16146) = Index 
$3F13 (16147) = Directory 
$3F14 (16148) = Key 
$3F15 (16149) = Alias 
$3F16 (16150) = Drive 
$3F17 (16151) = Server error 
$3F18 (16152) = Server message 
$3F19 (16153) = Line Number 
$3F1A (16154) = Capability 
$3F1B (16155) = Dictionary 
$3F1D (16157) = Object 
$3F1E (16158) = Limit 
$3F1F (16159) = Expression 
$3F70 (16240) = WORK 
$3F71 (16241) = PRIV 
$3F72 (16242) = Records copied 
$3F73 (16243) = Records appended 
$3F74 (16244) = LineNo 
$3F75 (16245) = Line 
$3F76 (16246) = Reason 



Взято с сайта

Список префиксов Internal Error

Список префиксов Internal Error

Иногда выскакивают ошибки типа "Internal Error SY424", вот расшифровка префиксов:

B : debugger
BC : debugger
BR : browser
C : codegen
CM : command line version of the compiler
D : parser
DB : debugger
DBG: debug info output
DM : IDE version of the compiler
E : parser
EO : debugger/evaluator
FN : filename / pathname parsing
GH : HPP generator
I : code generator
IN : inspectors
L : linker
LI : BPI file writing
LO : object file loading
M : memory allocation
MA : name mangling
MB : multi-byte (MBCS) support
O : object (OMF) file handling
P : package managment
R : resource writing
S : scanner
ST : standard procedure handling
SY : symbol table
T : code generator
TI : RTTI generator
U : parser
UD : IDE version of the compiler
UI : error handling
URW: DCU reading/writing
W : Object file (OMF) writing
X : code generator




Взято с сайта

Список шрифтов, совместимых одновременно с экраном и с принтером

Список шрифтов, совместимых одновременно с экраном и с принтером

Эти установки должны показать шрифты совместимые либо с принтером либо с экраном. В примере диалог Windows ChooseFont вызывается напрямую чтобы показать список шрифтов, совместимых одновременно и с экраном и с принтером.

Пример:

usesPrinters, CommDlg;

procedure TForm1.Button1Click(Sender: TObject);
 var cf: TChooseFont; lf: TLogFont; tf: TFont;
begin
  if PrintDialog1.Execute then
  begin
    cf.hdc := Printer.Handle;
    cf.lpLogFont := @lf;
    cf.iPointSize := Form1.Canvas.Font.Size * 10;
    cf.Flags := CF_BOTH or CF_INITTOLOGFONTSTRUCT or
     CF_EFFECTS or CF_SCALABLEONLY or CF_WYSIWYG;
    cf.rgbColors := Form1.Canvas.Font.Color;
    tf.COlor := cf.RgbColors;
    Form1.Canvas.Font.Assign(tf);
    tf.Free;
    Form1.Canvas.TextOut(10, 10, 'Test');
  end;
end;

Взято из

Справочные материалы по BDE

Справочные материалы по BDE

Cодержание раздела:







·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  
·  

SQL-запросы в Delphi

SQL-запросы в Delphi

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

1. Введение

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

Данный документ делает акцент на втором методе доступа к базам данных, на основе запросов SQL (pass-through). Авторы не стремились создать курсы по изучению синтаксиса языка SQL и его применения, они ставили перед собой цель дать несколько примеров использования компонентов TQuery и TStoredProc. Но чтобы сделать это, необходимо понимать концепцию SQL и знать как работают selects, inserts, updates, views, joins и хранимые процедуры (stored procedures). Документ также вскользь касается вопросов управления транзакциями и соединения с базой данных, но не акцентирует на этом внимание. Итак, приступая к теме, создайте простой запрос типа SELECT и отобразите результаты.

2. Компонент TQuery

Если в ваших приложениях вы собираетесь использовать SQL, то вам непременно придется познакомиться с компонентом TQuery. Компоненты TQuery и TTable наследуются от TDataset. TDataset обеспечивает необходимую функциональность для получения доступа к базам данных. Как таковые, компоненты TQuery и TTable имеют много общих признаков. Для подготовки данных для показа в визуальных компонентах используется все тот же TDatasource. Также, для определения к какому серверу и базе данных необходимо получить доступ, необходимо задать имя псевдонима. Это должно выполняться установкой свойства aliasName объекта TQuery.

Свойство SQL

Все же TQuery имеет некоторую уникальную функциональность. Например, у TQuery имеется свойство с именем SQL. Свойство SQL используется для хранения SQL-запроса. Ниже приведены основные шаги для составления запроса, где все служащие имеют зарплату свыше $50,000.

Создайте объект TQuery

Задайте псевдоним свойству DatabaseName. (Данный пример использует псевдоним IBLOCAL, связанный с демонстрационной базой данных employee.gdb).

Выберите свойство SQL и щелкните на кнопке с текстом - '...' (три точки, Инспектор Объектов - В.О.). Должен появиться диалог редактора списка строк (String List Editor).

Введите: Select* from EMPLOYEE where SALARY>50000. Нажмите OK.

Выберите в Инспекторе Объектов свойство Active и установите его в TRUE.

Разместите на форме объект TDatasource.

Установите свойство Dataset у TDatasource в Query1.

Разместите на форме TDBGrid.

Установите его свойство Datasource в Datasource1.
Свойство SQL имеет тип TStrings. Объект TStrings представляет собой список строк, и чем-то похож на массив. Тип данных TStrings имеет в своем арсенале команды добавления строк, их загрузки из текстового файла и обмена данными с другим объектом TStrings. Другой компонент, использующий TStrings - TMemo. В демонстрационном проекте ENTRSQL.DPR (по идее, он должен находится на отдельной дискетте, но к "Советам по Delphi" она не прилагается - В.О.), пользователь должен ввести SQL-запрос и нажать кнопку "Do It" ("сделать это"). Результаты запроса отображаются в табличной сетке. В Листинге 1 полностью приведен код обработчика кнопки "Do It".
Листинг 1



procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Query1.close; {Деактивируем запрос в качестве одной из мер предосторожности }  
Query1.SQL.Clear; {Стираем любой предыдущий запрос}  
If Memo1.Lines[0] <> '' {Проверяем на предмет пустого ввода} then  
  Query1.SQL.Add(Memo1.Text) {Назначаем свойству SQL текст Memo}  
else  
begin  
messageDlg('Не был введен SQL-запрос', mtError, [mbOK], 0);  
exit;  
end;  
try        {перехватчик ошибок}  
Query1.Open;     {Выполняем запрос и открываем набор данных}  
except     {секция обработки ошибок}  
On e : EDatabaseError do {e - новый дескриптор ошибки}  
messageDlg(e.message, mtError, [mbOK],0); {показываем свойство message объекта e}  
end;      {окончание обработки ошибки}  
end;




Свойство Params

Этого должно быть достаточно для пользователя, знающего SQL. Тем не менее, большинство пользователей не знает этого языка. Итак, ваша работа как разработчика заключается в предоставлении интерфейса и создании SQL-запроса. В Delphi, для создания SQL-запроса на лету можно использовать динамические запросы. Динамические запросы допускают использование параметров. Для определения параметра в запросе используется двоеточие (:), за которым следует имя параметра. Ниже приведе пример SQL-запроса с использованием динамического параметра:

          select * from EMPLOYEE
          where DEPT_NO = :Dept_no

Если вам нужно протестировать, или установить для параметра значение по умолчанию, выберите свойство Params объекта Query1. Щелкните на кнопке '...'. Должен появиться диалог настройки параметров. Выберите параметр Dept_no. Затем в выпадающем списке типов данных выберите Integer. Для того, чтобы задать значение по умолчанию, введите нужное значение в поле редактирования "Value".
Для изменения SQL-запроса во время выполнения приложения, параметры необходимо связать (bind). Параметры могут изменяться, запрос выполняться повторно, а данные обновляться. Для непосредственного редактирования значения параметра используется свойство Params или метод ParamByName. Свойство Params представляет из себя массив TParams. Поэтому для получения доступа к параметру, необходимо указать его индекс. Для примера,

Query1.params[0].asInteger := 900;

Свойство asInteger читает данные как тип Integer (название говорит само за себя). Это не обязательно должно указывать но то, что поле имеет тип Integer. Например, если тип поля VARCHAR(10), Delphi осуществит преобразование данных. Так, приведенный выше пример мог бы быть записан таким образом:

Query1.params[0].asString := '900';

или так:

Query1.params[0].asString := edit1.text;

Если вместо номера индекса вы хотели бы использовать имя параметра, то воспользуйтесь методом ParamByName. Данный метод возвращает объект TParam с заданным именем. Например:

Query1.ParamByName('DEPT_NO').asInteger := 900;


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

Листинг 2

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
Query1.close;     {Деактивируем запрос в качестве одной из мер предосторожности }  
if not Query1.prepared then  
  Query1.prepare; {Убедимся что запрос подготовлен}  
  {Берем значение, введенное пользователем и заменяем  
  им параметр.}  
if edit1.text <> '' then {Проверяем на предмет пустого ввода}  
  Query1.ParamByName('DEPT_NO').AsString := edit1.text  
else  
  Begin  
    Query1.ParamByName('DEPT_NO').AsInteger := 0;  
    edit1.text := '0';  
  end;  
try        {перехватчик ошибок}  
  Query1.Open;     {Выполняем запрос и открываем набор данных}  
except     {секция обработки ошибок}  
  On e : EDatabaseError do {e - новый дескриптор ошибки} messageDlg(e.message,  
     mtError,  
     [mbOK],0); {показываем свойство message объекта e}  
end;     {окончание обработки ошибки}  
end;




Обратите внимание на процедуру, первым делом подготовливающую запрос. При вызове метода prepare, Delphi посылает SQL запрос на удаленный сервер. Сервер выполняет грамматический разбор и оптимизацию запроса. Преимущество такой подготовки запроса состоит в его предварительном разборе и оптимизации. Альтернативой здесь может служить подготовка сервером запроса при каждом его выполнении. Как только запрос подготовлен, подставляются необходимые новые параметры, и запрос выполняется.

Источник данных

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

Примечание: Следующий пример использует TTable с именем Table1. Для Table1 имя базы данных IBLOCAL, имя таблицы - DEPARTMENT. DataSource2 TDatasource связан с Table1. Таблица также активна и отображает записи в TDBGrid.

Способ подключения TQuery к TTable - через TDatasource. Есть два основных способа сделать это. Во-первых, разместить код в обработчике события TDatasource OnDataChange. Например, листинг 3 демонстрирует эту технику.

Листинг 3 - Использования события OnDataChange для просмотра дочерних записей



procedure TForm1.DataSource2DataChange(Sender: TObject; Field: TField);
begin
Query1.Close;  
if not Query1.prepared  
then  
Query1.prepare;  
Query1.ParamByName('Dept_no').asInteger := Table1Dept_No.asInteger;  
try  
 Query1.Open;  
except  
On e : EDatabaseError do  
messageDlg(e.message, mtError, [mbOK], 0);  
end;  
end;



Техника с использованием OnDataChange очень гибка, но есть еще легче способ подключения Query к таблице. Компонент TQuery имеет свойство Datasource. Определяя TDatasource для свойства Datasource, объект TQuery сравнивает имена параметров в SQL-запросе с именами полей в TDatasource. В случае общих имен, такие параметры заполняются автоматически. Это позволяет разработчику избежать написание кода, приведенного в листинге 3 (*** приведен выше ***).

Фактически, техника использования Datasource не требует никакого дополнительного кодирования. Для поключения запроса к таблице DEPT_NO выполните действия, приведенные в листинге 4.

Листинг 4 - Связывание TQuery c TTable через свойство Datasource

Выберите у Query1 свойство SQL и введите:

             select * from EMPLOYEE
             where DEPT_NO = :dept_no

Выберите свойство Datasource и назначьте источник данных, связанный с Table1 (Datasource2 в нашем примере)
Выберите свойство Active и установите его в True

Это все, если вы хотите создать такой тип отношений. Тем не менее, существуют некоторые ограничения на параметризованные запросы. Параметры ограничены значениями. К примеру, вы не можете использовать параметр с именем Column или Table. Для создания запроса, динамически изменяемого имя таблицы, вы могли бы использовать технику конкатенации строки. Другая техника заключается в использовании команды Format.

Команда Format

Команда Format заменяет параметры форматирования (%s, %d, %n и пр.) передаваемыми значениями. Например,

Format('Select * from %s', ['EMPLOYEE'])

Результатом вышеприведенной команды будет 'Select * from EMPLOYEE'. Функция буквально делает замену параметров форматирования значениями массива. При использовании нескольких параметров форматирования, замена происходит слева направо. Например,



tblName := 'EMPLOYEE';
fldName := 'EMP_ID';
fldValue := 3;
Format('Select * from %s where %s=%d', [tblName, fldName, fldValue])




Результатом команды форматирования будет 'Select * from EMPLOYEE where EMP_ID=3'. Такая функциональность обеспечивает чрезвычайную гибкость при динамическом выполнении запроса. Пример, приведенный ниже в листинге 5, позволяет вывести в результатах поле salary. Для поля salary пользователь может задавать критерии.

Листинг 5 - Использование команды Format для создания SQL-запроса

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  sqlString: string; {здесь хранится SQL-запрос}
  fmtStr1,
    fmtStr2: string; {здесь хранится строка, передаваемая для форматирования}

begin
{ Создание каркаса запроса }
  sqlString := 'Select EMP_NO %s from employee where SALARY %s';

  if showSalaryChkBox.checked {Если checkbox Salary отмечен} then
    fmtStr1 := ', SALARY'
  else
    fmtStr1 := '';
  if salaryEdit.text <> '' { Если поле редактирования Salary не пустое } then
    fmtStr2 := salaryEdit.text
  else
    fmtStr2 := '>0';

  Query1.Close; {Деактивируем запрос в качестве одной из мер предосторожности }
  Query1.SQL.Clear; {Стираем любой предыдущий запрос}
  Query1.SQL.Add(Format(sqlString, [fmtStr1, fmtStr2])); {Добавляем}
{форматированную строку к свойству SQL}

  try {перехватчик ошибок}
    Query1.Open; {Выполняем запрос и открываем набор данных}
  except {секция обработки ошибок}
    on e: EDatabaseError do {e - новый дескриптор ошибки}
      messageDlg(e.message, mtError, [mbOK], 0);
{показываем свойство message объекта e}
  end; {окончание обработки ошибки}
end;

В этом примере мы используем методы Clear и Add свойства SQL. Поскольку "подготовленный" запрос использует ресурсы сервера, и нет никакой гарантии что новый запрос будет использовать те же таблицы и столбцы, Delphi, при каждом изменении свойства SQL, осуществляет операцию, обратную "подготовке" (unprepare). Если TQuery не был подготовлен (т.е. свойство Prepared установлено в False), Delphi автоматически подготавливает его при каждом выполнении. Поэтому в нашем случае, даже если бы был вызван метод Prepare, приложению от этого не будет никакой пользы.

Open против ExecSQL

В предыдущих примерах TQuerie выполняли Select-запросы. Delphi рассматривает результаты Select-запроса как набор данных, типа таблицы. Это просто один класс допустимых SQL-запросов. К примеру, команда Update обновляет содержимое записи, но не возвращает записи или какого-либо значения. Если вы хотите использовать запрос, не возвращающий набор данных, используйте ExecSQL вместо Open. ExecSQL передает запрос для выполнения на сервер. В общем случае, если вы ожидаете, что получите от запроса данные, то используйте Open. В противном случае допускается использование ExecSQL, хотя его использование с Select не будет конструктивным. Листинг 6 содержит код, поясняющий сказанное на примере.

Листинг 6

procedure TForm1.BitBtnClick(sender: TObject)
begin
  Query1.Close;
  Query1.Clear;
  Query1.SQL.Add('Update SALARY from EMPLOYEE ' +
    'where SALARY<:salary values (SALARY*(1+:raise)');
  Query1.paramByName('salary').asString := edit1.text;
  Query1.paramByName('raise').asString := edit2.text;
  try
    Query1.ExecSQL;
  except
    on e: EDatabaseError do
      messageDlg(e.message, mtError, [mbOK], 0);
  end;
end;

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

3. Компонент TStoredProc

Хранимая процедура представляет собой список команд (SQL или определенного сервера), хранимых и выполняемых на стороне сервера. Хранимые процедуры не имеют концептуальных различий с другими типами процедур. TStoredProc наследуется от TDataset, поэтому он имеет много общих характеристик с TTable и TQuery. Особенно заметно сходство с TQuery. Поскольку хранимые процедуры не требуют возврата значений, те же правила действуют и для методов ExecProc и Open. Каждый сервер реализует работу хранимых процедур с небольшими различиями. Например, если в качестве сервера вы используете Interbase, хранимые процедуры выполняются в виде Select-запросов. Например, чтобы посмотреть на результаты хранимой процедуры, ORG_CHART, в демонстрационной базе данных EMPLOYEE, используйте следующих SQL-запрос:

 Select * from ORG_CHART

При работе с другими серверами, например, Sybase, вы можете использовать компонент TStoredProc. Данный компонент имеет свойства для имен базы данных и хранимой процедуры. Если процедура требует на входе каких-то параметров, используйте для их ввода свойство Params.
4. TDatabase

Компонент TDatabase обеспечивает функциональность, которой не хватает TQuery и TStoredProc. В частности, TDatabase позволяет создавать локальные псевдонимы BDE, так что приложению не потребуются псевдонимы, содержащиеся в конфигурационном файле BDE. Этим локальным псевдонимом в приложении могут воспользоваться все имеющиеся TTable, TQuery и TStoredProc. TDatabase также позволяет разработчику настраивать процесс подключения, подавляя диалог ввода имени и пароля пользователя, или заполняя необходимые параметры. И, наконец, самое главное, TDatabase может обеспечивать единственную связь с базой данных, суммируя все операции с базой данных через один компонент. Это позволяет элементам управления для работы с БД иметь возможность управления транзакциями.

Транзакцией можно считать передачу пакета информации. Классическим примером транзакции является передача денег на счет банка. Транзакция должна состоять из операции внесения суммы на новый счет и удаления той же суммы с текущего счета. Если один из этих шагов по какой-то причине был невыполнен, транзакция также считается невыполненной. В случае такой ошибки, SQL сервер позволяет выполнить команду отката (rollback), без внесения изменений в базу данных. Управление транзакциями зависит от компонента TDatabase. Поскольку транзакция обычно состоит из нескольких запросов, вы должны отметить начало транзакции и ее конец. Для выделения начала транзакции используйте TDatabase.BeginTransaction. Как только транзакция начнет выполняться, все выполняемые команды до вызова TDatabase.Commit или TDatabase.Rollback переводятся во временный режим. При вызове Commit все измененные данные передаются на сервер. При вызове Rollback все изменения теряют силу. Ниже в листинге 7 приведен пример, где используется таблица с именем ACCOUNTS. Показанная процедура пытается передать сумму с одного счета на другой.

Листинг 7

procedure TForm1.BitBtn1Click(Sender: TObject);
{ ПРИМЕЧАНИЕ: Поле BALANCE у ACCOUNTS имеет триггер, проверяющий
ситуацию, когда вычитаемая сумма превышает BALANCE. Если так, UPDATE
будет отменен}
begin
  try
    database1.StartTransaction;
    query1.SQL.Clear;
{ Вычитаем сумму из выбранного счета }
    query1.SQL.Add(Format('update ACCOUNTS ' +
      'set BALANCE = BALANCE - %s ) ' +
      'where ACCT_NUM = %s ',
      [edit1.text,
      Table1Acct_Num.asString]));
    query1.ExecSQL;
    query1.SQL.Clear;
{ Добавляем сумму к выбранному счету }
    query1.SQL.Add(Format('update ACCOUNTS ' +
      'set BALANCE = BALANCE + %s ' +
      'where ACCT_NUM = %s ',
      [edit1.text,
      Table2Acct_Num.asString]));
    query1.ExecSQL;
    database1.Commit; {В этом месте делаем все изменения}
    table1.Refresh;
    table2.Refresh;
  except
{При возникновении в приведенном коде любых ошибок,
откатываем транзакцию назад}
    One: EDatabaseError do
    begin
      messageDlg(e.message, mtError, [mbOK], 0);
      database1.rollback;
      exit;
    end;
    One: Exception do
    begin
      messageDlg(e.message, mtError, [mbOK], 0);
      database1.rollback;
      exit;
    end;
  end;
end;

И последнее, что нужно учесть при соединении с базой данных. В приведенном выше примере, TDatabase использовался в качестве единственного канала для связи с базой данных, поэтому было возможным выполнение только одной транзакции. Чтобы выполнить это, было определено имя псевдонима (Aliasname). Псевдоним хранит в себе информацию, касающуюся соединения, такую, как Driver Type (тип драйвера), Server Name (имя сервера), User Name (имя пользователя) и другую. Данная информация используется для создания строки соединения (connect string). Для создания псевдонима вы можете использовать утилиту конфигурирования BDE, или, как показано в примере ниже, заполнять параметры во время выполнения приложения.

TDatabase имеет свойство Params, в котором хранится информация соединения. Каждая строка Params является отдельным параметром. В приведенном ниже примере пользователь устанавливает параметр User Name в поле редактирования Edit1, а параметр Password в поле Edit2. В коде листинга 8 показан процесс подключения к базе данных:

Листинг 8

procedure TForm1.Button1Click(Sender: TObject);
begin
  try
    with database1 do
      begin
        Close;
        DriverName := 'INTRBASE';
        KeepConnection := TRUE;
        LoginPrompt := FALSE;
        with database1.Params do
          begin
            Clear;
            Add('SERVER NAME=C:\IBLOCAL\EXAMPLES\EMPLOYEE.GDB');
            Add('SCHEMA CACHE=8');
            Add('OPEN MODE=READ/WRITE');
            Add('SQLPASSTHRU MODE=SHARED NOAUTOCOMMIT');
            Add('USER NAME=' + edit1.text);
            Add('PASSWORD=' + edit2.text);
          end;
        Open;
      end;
    session.getTableNames(database1.databasename, '*',
      TRUE,
      TRUE,
      ComboBox1.items);
  except
    One: EDatabaseError do
    begin
      messageDlg(e.message, mtError, [mbOK], 0);
    end;
  end;
end;

Этот пример показывает как можно осуществить подключение к серверу без создания псевдонима. Ключевыми моментами здесь являются определение DriverName и заполнение Params информацией, необходимой для подключения. Вам не нужно определять все параметры, вам необходимо задать только те, которые не устанавливаются в конфигурации BDE определенным вами драйвером базы данных. Введенные в свойстве Params данные перекрывают все установки конфигурации BDE. Записывая параметры, Delphi заполняет оставшиеся параметры значениями из BDE Config для данного драйвера. Приведенный выше пример также вводит такие понятия, как сессия и метод GetTableNames. Это выходит за рамки обсуждаемой темы, достаточно упомянуть лишь тот факт, что переменная session является дескриптором database engine. В примере она добавлена только для "показухи".

Другой темой является использование SQLPASSTHRU MODE. Этот параметр базы данных отвечает за то, как натив-команды базы данных, такие, как TTable.Append или TTable.Insert будут взаимодействовать с TQuery, подключенной к той же базе данных. Существуют три возможных значения: NOT SHARED, SHARED NOAUTOCOMMIT и SHARED AUTOCOMMIT. NOT SHARED означает, что натив-команды используют одно соединение с сервером, тогда как запросы - другое. Со стороны сервера это видится как работа двух разных пользователей. В любой момент времени, пока транзакция активна, натив-команды не будут исполняться (committed) до тех пор, пока транзакция не будет завершена. Если был выполнен TQuery, то любые изменения, переданные в базу данных, проходят отдельно от транзакции.

Два других режима, SHARED NOAUTOCOMMIT и SHARED AUTOCOMMIT, делают для натив-команд и запросов общим одно соединение с сервером. Различие между двумя режимами заключаются в передаче выполненной натив-команды на сервер. При выбранном режиме SHARED AUTOCOMMIT бессмысленно создавать транзакцию, использующую натив-команды для удаления записи и последующей попыткой осуществить откат (Rollback). Запись должна быть удалена, а изменения должны быть сделаны (committed) до вызова команды Rollback. Если вам нужно передать натив-команды в пределах транзакции, или включить эти команды в саму транзакцию, убедитесь в том, что SQLPASSTHRU MODE установлен в SHARED NOAUTOCOMMIT или в NOT SHARED.

5. Выводы

Delphi поддерживает множество характеристик при использовании языка SQL с вашими серверами баз данных. На этой ноте разрешите попращаться и пожелать почаще использовать SQL в ваших приложениях.

Взято с

Сравнительный анализ технологий CORBA и COM

Сравнительный анализ технологий CORBA и COM

В последние 2-3 года резко возрос интерес к так называемым распределенным системам. Под распределенными системами обычно понимают программные комплексы, составные части которых функционируют на разных компьютерах в сети. Эти части взаимодействуют друг с другом, используя ту или иную технологию различного уровня - от непосредственного использования сокетов TCP/IP до технологий с высоким уровнем абстракции, таких, как RMI или CORBA.
Рост популярности распределенных систем вызван существенным ужесточением требований, предъявляемых заказчиком к современным программным продуктам.

Пожалуй, важнейшими из этих требований являются следующие:
·Обеспечение масштабируемости систем, т.е. способности эффективно обслуживать как малое, так и очень большое количество клиентов одновременно.
·Надежность создаваемых приложений. Программный комплекс должен быть устойчив не только к ошибкам пользователей (это определяется главным образом качеством клиентских приложений), но и к сбоям в системе коммуникаций. Надежность подразумевает использование транзакций, т.е. гарантированного перехода системы в процессе функционирования из одного устойчивого и достоверного состояния в другое.  
·Возможность непрерывной работы в течение длительного времени (так называемый режим 24x7, т.е. режим круглосуточной работы в течение недель и месяцев).  
·Высокий уровень безопасности системы, под которой понимается не только контроль доступности тех или иных ресурсов системы и защищенность информации на всех этапах функционирования, но и отслеживание выполняемых действий с высокой степенью достоверности.  
·Высокая скорость разработки приложений и простота их сопровождения и модификации с использованием программистов средней квалификации.  
·Оказалось, что обеспечить соответствие этим требованиям, используя традиционные технологии - а именно, двухзвенные системы клиент-сервер, в которых в качестве серверов выступают системы управления базами данных, почти невозможно.  
·Заметим, что далеко не для всех приложений вышеперечисленные требования являются существенными. Легко представить распределенную систему, которая функционирует на небольшом (до 100) количестве компьютеров, работающих в локальной сети, где нет проблем с перезапуском одного или двух-трех серверов в случае необходимости, а главными задачами, для решения которых используются распределенные технологии, являются задачи использования функциональности нескольких стандартных серверов приложений (например, текстовых процессоров, броузеров и электронных таблиц) в интересах клиентских задач. Необходимо иметь в виду, что термин распределенные системы относится к огромному числу задач самого разного класса.  
Данный обзор содержит сравнительный анализ двух наиболее популярных и комплексных систем создания распределенных приложений, а именно, CORBA консорциума OMG и COM (DCOM, COM+) фирмы Microsoft. Этот обзор предназначен главным образом для менеджеров проектов, руководителей информационных служб и др., т.е. для тех, кому приходится принимать ответственные, стратегические решения. Вследствие этого, в нем будут отсутствовать чисто технические аспекты обоих технологий, которые интересны только для разработчиков.
Кроме того, при написании обзора не ставилась задача сделать окончательный вывод типа ... таким образом, CORBA (COM), бесспорно, лучше, чем COM (CORBA). Связано это не с модной в наше время политкорректностью или отсутствием у автора своей точки зрения по этому вопросу. Дело даже не в том, что существуют определенные трудности с формализацией такого сравнения - я мог бы представить результаты сравнительных анализов, в которых используются численные оценки (баллы), выставленные экспертами, весовые коэффициенты и прочее, что придает отчету серьезный и весомый вид. Дело в том, что COM и CORBA можно сравнивать только с учетом определенных допущений. Отказ от таких допущений легко позволяет получить какой угодно результат. Вот эти допущения:
·CORBA, в отличие от COM'а, является концепцией, а не ее реализацией. Когда мы говорим COM, то понимаем под этим скорее набор конкретных средств - элементов операционной системы, библиотек, утилит и т.п., являющихся составной частью того, что называется Microsoft Windows. Под термином CORBA понимается именно сложная и развитая концепция, сформулированная на уровне специального языка описаний - IDL. Реализации же этой концепции могут сильно отличаться друг от друга по различным критериям, наиболее важным в том или другом случае. Inprise/Corel VisiBroker и Application Server, BEA WebLogic, Iona Orbix, Oracle Application Server и картриджи Oracle, IBM BOSS - все эти продукты используют те или иные возможности CORBA. Технология Sun Enterpise JavaBeans создана поверх CORBA и использует такие ее возможности, как удаленный вызов объектов, службу имен, управление транзакциями. Реализация EJB фирмы Inprise связано с CORBA еще более тесным образом. Мы будем сравнивать COM и CORBA именно как концепции создания распределенных систем, а не как ту или иную их реализацию.  
·При работе с реальным проектом необходимо учитывать область применения той или иной технологии. COM (как цельное и комплексное решение) способен функционировать только под Windows NT/Windows2000. Рассуждения о переносе COM на другие операционные системы в настоящий момент носят скорее рекламный характер. Ни компонентная модель COM (т.е. ActiveX), ни монитор транзакций (Microsoft Transaction Server, MTS) не способны работать нигде, кроме Windows, и сама Microsoft не проявляет никакой активности в этом напрвлении (вопросами переноса тех или иных элементов COM на другие платформы занимается консорциум Open Group). CORBA является многоплатформенным решением просто по определению.  
·Помимо чисто технологических аспектов, при принятии решения необходимо оценить затраты на закупку необходимого программного обеспечения, его сопровождения и обучение персонала. COM (в отличие от CORBA) официально является бесплатной технологией. Вы получаете все необходимое, просто приобретя, например, Windows NT Server. (Кстати, сам факт конкуренции дорогостоящей технологии с аналогичной, но бесплатной, многое говорит об их технических возможностях).  
·Наличие готовых серверов приложений, пригодных для решения вашей задачи. Если Вы можете решить свои проблемы, используя функциональность Microsoft Office, то ничего лучше COM вы, естественно, не найдете.  
·Таким образом, главной задачей настоящего обзора является попытка помочь руководителю того или иного уровня принять квалифицированное решение в каждом конкретном случае. Поскольку и CORBA, и COM позиционируются соответственно OMG и Microsoft как универсальные технологии создания распределенных систем, мы будем оценивать и сравнивать их именно с этой точки зрения. Предполагается, что для проекта используется платформа Windows (в противном случае нечего рассматривать COM) и имеется достаточно средств для закупки основных стандартных частей той или иной реализации (иначе обсуждение CORBA теряет смысл).  

Концептуальный фундамент технологии
COM
Технология создавалась фирмой Microsoft как средство взаимодействия приложений (в том числе составных частей операционной системы) Windows, функционирующих на одном компьютере, с последующим развитием для использования в пределах локальной сети. Главная задача на момент создания - обеспечение технологии Object Linking and Embedding (OLE 1.0). Характерно, что обмен данными между приложениями (Dynamic Data Exchange, DDE) первоначально строился не по COM-технологии, а с использованием механизма сообщений (messages). Развитие технологии идет по мере добавления новых возможностей. Как универсальная технология взаимодействия приложений COM начал использоваться с OLE 2.0 (1991). Концепция технологии неразрывно связана с ее реализацией. Появление новых возможностей - это просто появление новых библиотек, функций API и утилит Windows. Общий знаменатель технологии - двоичная структура объекта, хотя в настоящий момент существует язык описания структуры объекта - Interface definition Language (IDL).  
CORBA
Технология создавалась консорциумом OMG как универсальная технология создания распределенных систем в гетерогенных средах. OMG представляет собой некоммерческую организацию, являющуюся содружеством разработчиков программного обеспечения и его потребителей, объединивших свои усилия для создания спецификаций этой технологии. В настоящий момент в OMG состоит более 800 членов, включая всех сколько-нибудь серьезных производителей программного обеспечения (и даже c недавнего времени Microsoft). Первая спецификация CORBA появилась в 1991 г. Новые возможности официально считаются добавленными в CORBA в момент утверждения соответствующей спецификации. Как правило, в разработке спецификации участвуют крупнейшие специалисты в данной области. Разработка реализации - задача конкретной фирмы. Обычно от утверждения спецификации до появления высококачественной реализации проходит довольно много времени - иногда несколько лет. Общий знаменатель технологии - объявления на языке IDL, который является сердцем CORBA с момента ее появления. (Существуют три различных языка описаний с одним и тем же названием - OSF IDL, Microsoft IDL и OMG IDL).  
 

Выводы

Технология CORBA носит существенно более общий и универсальный характер, чем COM, что заложено в ее фундаменте. Опережение разработки спецификаций (по сравнению с реализациями) позволяет добиться более связной, целостной и гармоничной системы. С другой стороны, при разработке реального проекта нужно предварительно убедиться, что высококачественная реализация того или иного сервиса CORBA уже доступна (источниками проблем могут служить, например, Persistence Service и Security Service).

Комплексность системы
COM
COM содержит все необходимое, что нужно для построения распределенной системы: технологию удаленного вызова методов (как статических, так и динамических), базы данных серверных объектов (библиотеки типов), которые могут быть импортированы для анализа структуры серверов COM, универсальный протокол обмена между клиентами и серверами, спецификации так называемых составных документов (ActiveDoc), объектный монитор транзакций (MTS), компонентную модель (ActiveX) и др. Все составные части прекрасно соответствуют друг другу в рамках модели COM. Уникальной возможностью COM является универсальная технология доступа к базам данных - OLE DB/ADO.
CORBA
В настоящий момент CORBA не имеет своей собственной компонентной модели; работа над ней началась в 1998 г. и еще не завершена. Это главный серьезный недостаток. Правда, он несколько компенсируется наличием основанной на CORBA компонентной моделью Enterprise JavaBeans, так что программисты на Java находятся в привилегированном положении. Все остальное, что присутствует в COM, имеется и в CORBA, и даже более того - за исключением универсальной технологии доступа к БД. Опять-таки, Java-программисты имеют преимущество и здесь - за счет наличия общей для Java технологии доступа к данным JDBC.  
 
Выводы
В настоящий момент COM более законченная система, но на более низком уровне и при существенно большем количестве ограничений, определяемых самой концепцией системы.

Используемые языки программирования
COM
Потенциально COM могут поддерживать самые различные языки программирования - все решает фирма Microsoft. Добавление некоторых расширений или экспертов (wizard) в систему разработки позволит использовать для работы с COM любой язык программирования. В настоящий момент наиболее широко используются Visual Basic, C++ и Delphi. Серьезные проблемы возникли при использования языка, на который возлагались особые надежды - с Java. Microsoft добилась прекрасного взаимодействия Java с COM, но достигнуто это было путем отказа от переносимости таких Java-программ на другие виртуальные машины Java. Не случайно продукт фирмы Microsoft - J++ - не содержит в названии Java. Вообще, уровень стандартизации для COM достаточно слаб. Это не обязательно нужно рассматривать как недостаток - в конце концов, язык C лет пятнадцать прекрасно обходился без формального стандарта.  
CORBA
Под стандартом применительно к CORBA понимается то, что официально утверждено консорциумом OMG. Надо сказать, что это очень высокий уровень легитимности, так как авторитет OMG в компьютерном мире чрезвычайно высок. В настоящий момент стандартизовано отображение языка IDL на 6 языков программирования - Ada, C, C++, Cobol, Java и Smalltalk. Существуют также отображения на Pascal (точнее, Delphi), Perl, Python и еще десяток языков.  
Наиболее используемыми языками в настоящий момент являются Java (вследствие прекрасного взаимодействия Java-технологий, особенно JDBC, RMI, JNDI и EJB, с CORBA), и C++ - как самый эффективный, мощный и распространенный язык компьютерной индустрии.
Выводы
Обе технологии не испытывают особых проблем с точки зрения взаимодействия с языками программирования. Некоторые преимущества имеет CORBA - за счет более строгой стандартизации и более богатого выбора доступных средств разработки.

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

Поддержка компонентной модели
COM
Компонентная модель Microsoft, базирующаяся на COM-технологии, в основе имеет двоичную структуру объектов. Это не вызывает никаких проблем при ориентации на одну платформу и операционную систему. Безусловным достоинством такой модели является простота создания компонентов с использованием различных языков программирования. С другой стороны, такая компонентная модель неизбежно связана с определенными ограничениями и недостатками. Одним из самых серьезных недостатков является то, что ее нельзя, строго говоря, назвать объектно-ориентированной.  
CORBA
Как уже говорилось, CORBA в настоящее время не имеет своей компонентной модели. Пусть это не имеет практического значения для Java-программистов, но в общем случае эта та область, где OMG (и фирмам-производителям программного обеспечения) еще предстоит серьезно поработать.  
Выводы
Это та область, где COM пока имеет существенные преимущества по сравнению с CORBA. C другой стороны, при разработке реальных проектов использование на стороне сервера компонентов Enterprise JavaBeans, построенных поверх инфраструктуры CORBA, предоставляет разработчику значительные преимущества по сравнению с компонентами ActiveX.

Универсальный протокол обмена
COM
Передача данных между клиентом и сервером основана на наборе типов, которые называются OLE Automation types. В принципе, схема маршалинга (в том числе типы передаваемых данных) определяется парой стандартных интерфейсов COM. Реализовав по-своему некоторые из методов этих интерфейсов, можно определить свою схему маршалинга. Впрочем, это нетривиальная задача, и обычно разработчики используют уже готовую стандартную реализацию. Упаковка данных и их передача могут быть реализованы поверх различных сетевых протоколов.  
CORBA
CORBA значительно более строго и формально подходит к механизмам обмена и передаче данных. Определен протокол CORBA (General Inter-ORB Protocol, GIOP) - и его реализация на базе протокола TCP/IP (Internet Inter-ORB Protocol, IIOP). CORBA способна передавать данные различных типов, включая структуры (struct) и объединения (union), в том числе содержащие рекурсивные определения. Предусмотрена система описания и контроля типов - как на уровне IDL-деклараций, так и динамическая. Для каждого языка используется свое отображение данных IDL. В версии 2.3 появился новый, заимствованный из RMI механизм передачи объектов CORBA - так называемая "передача по значению (objects-by-value)". В предыдущих версиях CORBA при вызове удаленных методов объекты можно было передавать только по ссылке.  
Выводы
CORBA предоставляет значительно больше возможностей, и эти возможности строго формализованы - в противном случае было бы невозможно обеспечить совместную работу различных средств от различных производителей программного обеспечения.

Поддержка со стороны различных производителей и открытость
COM
В настоящий момент официальным "хранителем стандарта" технологии COM является консорциум Open Group, хотя "главным игроком на этом поле" является, конечно же, Microsoft. Поддержкой технологии COM занимаются многие небольшие фирмы - некоторые из них создают компоненты ActiveX, некоторые - как Software AG - занимаются переносом фрагментов COM на другие платформы, некоторые - как Borland - создают RAD-инструменты, основанные в том числе и на COM. В любом случае, только Microsoft решает, какая часть технологии и в каком виде попадает из лабораторий Microsoft в открытые спецификации.  
CORBA
Ситуация с CORBA совершенно иная. CORBA является результатом совместных усилий огромного числа фирм, среди которых Sun, Oracle, IBM, Netscape/AOL, DEC/Compaq, JavaSoft, Borland/Visigenic (в настоящий момент в связи со слиянием Inprise и Corel принято решение о восстановлении имени Visigenic), BEA, Iona и многие другие. Можно сказать, что все производители программного обеспечения, которое должно функционировать на различных платформах и под управлением различных операционных систем, выбрали CORBA как стандартную инфраструктуру создания программных продуктов. Естественно, все спецификации CORBA являются полностью открытыми. В лагере сторонников CORBA просматривается четкая тенденция к тесному взаимодействию и некоторой унификации используемых технологий (в качестве примера можно привести отказ Sun и ORACLE от создания собственного ORB и лицензирование Visigenic VisiBroker).  
Выводы
COM и CORBA имеют совершенно разный уровень открытости и поддержки со стороны ведущих фирм в компьютерной индустрии.

Развитость сервисной части
COM
COM предоставляет минимальный набор совершенно необходимых средств - кодогенераторы c IDL, утилиты управления доступом (dcomcnfg) и др. Как правило, разработчики пользуются теми или иными инструментами, встроенными в конкретные средства разработки (примером может служит утилита работы с библиотеками типов или эксперт создания ActiveX-объектов в Borland Delphi/C++ Builder).  
CORBA
CORBA имеет очень развитую сервисную часть; например, только для поиска серверных объектов по различным критериям можно использовать 4 различных сервиса CORBA. Кроме того, OMG стремится к максимальной стандартизации вспомогательных возможностей CORBA.  
Выводы
CORBA предоставляет разработчикам существенно большие возможности, чем COM, в области сервисов и вспомогательных средств. С другой стороны, COM-программисты обычно не испытывают какого-либо дискомфорта из-за их недостатка. Вследствие ограниченности области применения COM объективно нет необходимости в создании таких же развитых и универсальных средств, как это совершенно необходимо для CORBA.

Самодокументирование системы
COM
COM предусиатривает возможность создания локальной базы данных, хранящей информацию о COM-объектах, их интерфейсах, методах и т.д. для сервера приложений COM. Такая база данных называется библиотекой типов (type library). Использование библиотек типов не является обязательным для OLE, хотя это необходимо в технологии ActiveX. Для получения информации из type library пользователь должен явно импортировать ее, для чего необходимо выбрать соответствующую запись реестра Windows на конкретном компьютере.  
CORBA
CORBA имеет аналог библиотеки типов COM - это так называемый Репозитарий Интерфейсов (Interface Repository). Чтобы оценить принципиальную разницу в подходе CORBA по сравнению с COM, достаточно сказать, что Репозитарий Интерфейсов CORBA сам представляет из себя объект CORBA со всеми вытекающими из этого возможностями. Помимо Репозитария Интерфейсов, CORBA использует Репозитарий Реализаций (Implementation Repository), который представляет из себя базу данных, содержащую информацию о серверах приложений CORBA.  
Выводы
Средства интроспекции (самодокументрования) CORBA значительно более развиты, мощны, гибки и универсальны, чем аналогичные средства COM. CORBA-программисты получают дополнительные преимущества по сравнению со своими коллегами, работающими с COM, при использовании Java (Java-технологии очень тесно связаны с CORBA). Связано это с тем, что Java предусматривает свой уровень интроспекции, дополнительный по отношению к CORBA.

Технология и описание проекта
COM
Обычно объявления на языке IDL при работе с COM не являются существенной частью спецификации проекта, так как IDL-спецификации играют вспомогательную роль в COM-технологии вследствие ее базирования на двоичном стандарте объектов. Кроме того, язык Microsoft IDL не очень развит с точки зрения объявления типов данных, из которых строится программа.  
CORBA
Проект с использованием CORBA всегда начинается с написания IDL-спецификаций (особый случай - использование Java, когда в принципе возможно генерировать стандартный код CORBA непосредственно на базе классов Java, хотя вряд ли это разумно для больших проектов.). Эти IDL-спецификации прекрасно отражают суть выполняемых действий с точки зрения функционирования распределенной системы. Синтаксис OMG IDL очень похож на синтаксис С++ (включая те же самые директивы препроцессора). Таким образом, IDL-спецификации могут с успехом использоваться как часть документации проекта.  
Выводы
Описания OMG IDL более достоверны и существенно более наглядны, чем описания Microsoft IDL, в роли существенной части спецификации проекта.

Виды объектов
COM
Объекты COM всегда рассматривались (и продолжают рассматриваться) как серверные объекты, которые просто реализуют тот или иной набор методов. Различные объекты, реализующие один и тот же интерфейс и созданные с помощью обращения к одной и той же фабрике классов, не отличаются друг от друга. Объектная ссылка, которую получает клиент, является указателем на интерфейс и не содержит информации о конкретном объекте. Другими словами, COM оперирует объектами, не имеющими состояния. В общем случае, если клиент, используя одну и ту же объектную ссылку, в цикле вызвал десять раз один и тот же метод, он не может быть уверен, что он обратился к одному, а не к двум, пяти или десяти различным объектам. Естественно, объекты без состояния не имеет смысла хранить дольше, чем существует сервер приложений, в котором они были созданы. Такие объекты применительно к распределенным системам называются временными (transient). COM-объект - это конкретная переменная C++, Visual Basic или Pascal, находящаяся в оперативной памяти и существующая, пока работает создавший ее сервер приложений. Он может быть создана по запросу клиента или заранее (например, с помощью MTS). При работе с COM сопоставить с объектом какое-либо состояние - задача прикладного программиста. Это можно сделать, используя определенный режим создания объектов (выбрав модель управления потоками), хранить состояние объекта на стороне клиента (если это возможно) или использовать так называемые моникеры, которые можно рассматривать как обобщение понятия ключа записи в базе данных. Каждый из этих способов имеет очень существенные ограничения.  
CORBA
Понятие "объекта" в CORBA принципиально отличается от своего COM-аналога. Объект CORBA не является переменной языка программирования и в общем случае время его существования не связано со временем работы серверных или клиентских приложений. СORBA-объект не занимает никаких ресурсов компьютера - оперативной памяти, сетевых ресурсов и т.п. Эти ресурсы занимает только так называемый "сервант" (servant), который является "инкарнацией" одного или нескольких CORBA-объектов. Именно сервант является переменной языка программирования. Пока не существует сервант, сопоставленный с конкретным объектом CORBA, этот объект не может обслуживать вызовы клиентов, но, тем не менее, он существует. Результатом создания объекта (при этом совершенно не обязательно при этом создается и сопоставляется с этим объектом соответствующий сервант!) является так называемая "объектная ссылка" CORBA. Объектная ссылка сопоставлена с этим, и только с этим объектом, и это сопоставление остается корректным в течение всего срока существования CORBA-объекта (может быть, в течение нескольких лет). Объектная ссылка CORBA правильно интерпретируется ORB'ами от любого производителя программного обеспечения. После уничтожения CORBA-объекта все объектные ссылки на него навсегда теряют смысл. С помощью объектной ссылки клиент вызывает методы объекта, при этом инкарнациями этого объекта могут быть различные серванты (не более одного одновременно), которые физически могут находиться даже на различных компьютерах.  
Выводы
Объект COM может рассматриваться как достаточно примитивный частный случай объекта CORBA - как по своим возможностям, так и с точки зрения его цикла жизни. COM и CORBA предлагают совершенно несопоставимые возможности по созданию и управлению объектами, что жизненно важно для создания надежных и масштабируемых приложений.

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

Производительность
COM
COM демонстрирует очень высокую производительность. Читатель, интересующийся этим вопросом, найдет большое количество очень интересной информации в прекрасной книге R. Orfali и D. Harkey "Client/server Programming with Java and CORBA", second edition, Wiley, 1998. Разумеется, производительность существенно зависит от того, какой способ - статический или динамический - вы используете.  
CORBA
Для корректного сравнения CORBA и COM с точки зрения производительности необходимо составить целую систему тестов. Кроме того, необходимо учесть влияние использования того или иного языка программирования. На основе информации, приводимой Orfali и Harkey, а также результатов небольшого сравнительного тестирования, проведенного самим автором обзора (использовался Borland C++ Builder 4.0 и VisiBroker 3.3 для C++), можно сказать, что CORBA демонстрирует даже несколько более высокую производительность. Еще раз повторимся: производительность очень сильно зависит от количества и типов аргументов методов (не забывайте, что их нужно упаковать и передать по сети, а затем распаковать), от выбранной модели управления потоками, от используемых языков программирования (клиент и сервер при этом не обязательно должны быть написаны на одном языке), от конкретной реализации CORBA и многих других факторов.  
Выводы
И COM, и CORBA демонстрируют примерно одинаковую (и очень высокую) производительность. Для CORBA говорить о конкретных цифрах можно только для конкретной реализации. В качестве примера приведем следующий факт: Inprise/Visigenic Visibroker прозрачным для разработчика образом работает по-разному в зависимости от того, находятся ли клиентский и серверный объект в одном адресном пространстве, в разных адресных пространствах, но на одном компьютере, или на разных компьютерах. Производительность при этом может отличается на порядок.

Масштабируемость
COM
Проблемы обеспечения масштабируемости не были заложены в фундамент технологии, если не считать ориентацию на использование только объектов без состояния. Существенным препятствием для создания масштабируемых приложения является очень жесткая связь между клиентом и сервером (объект, т.е. совокупность ресурсов на сервере, не может быть удален, пока клиент явно не укажет, что этот объект больше не нужен). В реальных проектах необходимо управлять состоянием объектов, и это затрудняет создание масштабируемых приложений, так как это обязанность не COM, а программиста. Сильной стороной COM является гибкая модель управления потоками. Основным инструментом, повышающим уровень масштабируемости COM-систем, является MTS.  
CORBA
В отличие от COM, CORBA с самого начала рассматривалась как технология создания масштабируемых систем. Разделение собственно объектов CORBA и их сервантов, схемы соответствия между ними, характеристики объектных адаптеров, модели управления потоками и соединениями, схемы активации серверов приложений, универсальные решения по сохранению состояния объектов, автоматическое управление контекстом транзакций и безопасности - все это очень способствует решению данной проблемы.  
Выводы
Масштабируемость системы во многом зависит от качества разработки проекта, продуманности принимаемых решений и квалификации менеджеров проекта и разработчиков. При сравнении технологий можно говорить о предпосылках, способствующих (или, наоборот, препятствующих) достижению нужных требований. При прочих равных условиях CORBA имеет громадные преимущества по cравнению с COM.

Устойчивость к сбоям
COM
Устойчивость к сбоям COM-систем находится на невысоком уровне, в том числе из-за уже упомянутой излишне жесткой привязки клиентов и серверов. Основным средством обеспечения устойчивости к сбоям (оно же средство управления нагрузкой серверов) является диспетчер, который позволяет перенаправлять вызовы клиента на различные сервера приложений COM. Не слишком содействует отказоустойчивости системы и необходимость выполнения "вручную" большого количества действий по управлению транзакциями.  
CORBA
CORBA имеет несколько более высокий уровень устойчивости к сбоям за счет большей изоляции клиентов и серверов, автоматического сохранения состояния объектов, более мощной и продуманной схемы управления транзакциями (включая автоматический откат транзакций по тайм-ауту), а также автоматической привязки объектной ссылки и конкретного объекта CORBA.  
Выводы
Проблема обеспечения устойчивости к сбоям, так же как и проблемы обеспечения масштабируемости, не рассматривались как первоочередные при разработке концепции COM. С CORBA ситуация обстоит во многом лучше, но проблемы остаются и здесь. Обе технологии не имеют (или почти не имеют) стандарных средств обеспечения устойчивости к сбоям. Такие компоненты, как VisiBroker Smart Agents, не являются стандартным средством CORBA (хотя они и способны решить многие проблемы при работе с реальными проектами.)

Управление транзакциями
COM
Монитором транзакции в COM является MTS. Сервер приложений COM должен быть написан в специальном стиле для того, чтобы иметь возможность взаимодействовать с MTS (такой сервер приложений должен быть реализован в виде DLL). MTS позволяет достаточно гибко управлять режимами выполнения транзакций в системе и поддерживает двухфазное завершение транзакций. Одним из существенных недостатков схемы управления транзакциями COM является необходимость явной передачи контекста транзакции в качестве аргумента при вызове удаленных методов. Такая схема не является ни эффективной, ни гарантирующей от ошибок (особенно при вовлечении в транзакцию большого количества объектов).  
CORBA
Управление транзакциями берет на себя так называемый Сервис Управления Транзакциями CORBA (Object Transaction Service, OTS). Он является существенно более гибкой, продуманной и формализованной системой, чем MTS, и содержит все необходимое в рамках CORBA-модели. Сервер приложений CORBA и Сервис транзакций запускаются и работают независимо друг от друга. Важной особенностью CORBA является тесное взаимодействие OTS и ORB, что обеспечивает автоматическое распространение контекста транзакций в многопоточной распределенной среде. Спецификация CORBA предусматривает (необязательную) поддержку вложенных транзакций.  
Выводы
На уровне спецификаций Сервис транзакций CORBA имеет определенные преимущества перед MTS. На практике для реализации этих преимуществ нужно предпринять определенные действия. Особенно это касается двухфазного подтверждения транзакций при работе с гетерогенными базами данных. Например, для реализации такой схемы при работе с Java необходимо иметь специальные JDBC-драйвера, которые, насколько мне известно, в настоящий момент не слишком доступны для широкого круга баз данных. В этом плане COM имеет серьезные преимущества за счет взаимодействия MTS со стандартной технологией доступа к базам данных OLE DB/ADO.

Обеспечение безопасности
COM
В настоящий момент система безопасности COM базируется на системе безопасности Windows NT/Windows 2000; кроме того, предусмотрена защита данных при их передаче с использованием Socket Security Layer (SSL). Отдельная проблема - обеспечение безопасности при передаче компонентов ActiveX с использованием протокола HTTP. Здесь используется система электронных подписей, лицензий и т.п. - говоря упрощенно, клиент выполняет код компонента, который пришел с "правильного" сервера.  
CORBA
С CORBA дела обстоят сложнее - главным образом, в силу того, что ставилась задача создать универсальную систему безопасности, которая могла бы использовать все основные существующие в этой области технологии. Работа над Сервисом Безопасности (Security Service) продолжалась в течение 2 лет, и ее спецификация была принята в 1996 г. Она содержит около 250 страниц. Она позволяет обеспечить уровень безопасности B2 (уровень, близкий к высшему уровню защиты, который используется в государственных учреждениях). Предусмотрена идентификация пользователя, списки прав доступа к ресурсам, система аудита и многое другое. Особенно приятно, что разработчик не должен явно взаимодействовать с этим сервисом - это задача для ORB. Основная нагрузка возложена на системных администраторов. Все это прекрасно, но существует одна небольшая проблема - где взять полномасштабную, высококачественную реализацию этого сервиса? Такие реализации существуют (Gradient, Concept-5), но их использование ограниченно за пределами США. Сервис безопасности от Borland/Visigenic в этом году еще не появится (хотя работа над ним идет).  
Выводы
В настоящий момент для реальных проектов для обеих технологий используются сходные решения в области обеспечения безопасности (идентификация на уровне операционной системы и кодирование информации с помощью SSL). Естественно, возможны варианты. Потенциально CORBA предоставляет существенно большие возможности - проблемы здесь организационного, а не концептуального плана.

Взаимодействие с Internet
COM
Основой взаимодействия через Internet при работе с COM являются расширения возможностей протокола HTTP, выполненные Microsoft. Броузеры Microsoft (Internet Explorer 3 и выше) позволяют выполнять код ActiveX-компонентов, полученных с Web-серверов. Кроме того, URL доступны при использовании COM - с ними могут работать моникеры.  
CORBA
Спецификации CORBA не оговаривают использование Internet в качестве особого случая. Интеграция CORBA и Internet выполняется естественным образом - за счет использования протокола IIOP, построенного поверх TCP/IP. URL-имена могут быть использованы в качестве имен для Службы Именования CORBA. На практике производители программного обеспечения предоставляют расширения CORBA, упрощающие работу с Internet (VisiBroker URL Naming Service) или решающие те или иные проблемы - например, "обход" ограничений, накладываемых на апплеты Java, используемых в качестве CORBA-клиентов (например, Borland/Visigenic GateKeeper).  
Выводы
CORBA (особенно при использования Java) без каких-либо проблем может быть интегрирована с Internet. Взаимодействие COM и Internet основано на использовании ActiveX и требует использования только броузеров, поддерживающих тег <Object> Microsoft. Косвенным образом проблемы совместной работы COM и Internet могут возникнуть из-за несовместимости виртуальной машины Java Microsoft с другими виртуальными машинами.

Скорость разработки систем
COM
Скорость разработки COM-систем может быть очень высокой за счет интенсивного использования компонентной модели ActiveX, а также универсальных подходов, таких, как OLE DB. Не составляет особого труда создание Internet-приложений с броузером Microsoft в качестве клиентского приложения.  
CORBA
Скорость разработки CORBA-систем сильно зависит от используемой технологии. Наверное, максимально эффективным способом создания распределенных систем в настоящий момент является использование Java-технологий, основанных на CORBA - Enterprise JavaBeans и так называемых Application Server'ов, например, BEA WebLogic и Inprise Application Server. Использование этих технологий позволяет чрезвычайно быстро создавать высокоэффективные, масштабируемые, транзакционные сервера приложений. Клиентская часть таких систем может быть написана на любом языке программирования, поддерживающим CORBA.  
Выводы
При прочих равных условиях CORBA позволяет создавать распределенные системы быстрее, чем COM, за счет большей функциональности middleware и, соответственно, меньшей нагрузки на прикладного разработчика.

Простота использования
COM
COM очень прост для простых небольших приложений и чрезвычайно сложен как инструмент создания комплексных систем. Он содержит большое количество "узких" мест - недостаточно гибкую стандартную схему маршалинга, отсутствие состояния объектов, низкая устойчивость к сбоям. Технология не является объектно-ориентированной в классическом смысле этого слова, что в общем случае не способствует простоте ее использования. Достоинством технологии является комплексность и универсальность подходов в рамках COM-модели.  
CORBA
Сложность CORBA заключается в ее огромных возможностях. Программисту необходимо знать большое количество интерфейсов из различных сервисов CORBA, правильно использовать возможности объектных адаптеров и многое другое. Поскольку CORBA использует различные схемы отображения IDL на разные языки программирования, то программисту в общем случае надо знать их особенности для 2-3 наиболее широко используемых языков - в первую очередь, C++ и Java.  
Выводы
Объективно CORBA сложнее за счет того, что она предназначена для решения существенно более сложных задач, чем COM. При разработке реальных проектов нужно иметь в виду, что распределение "интеллектуальной" нагрузки среди участников разработки для COM и CORBA несколько отличается: в случае COM требуются более квалифицированные (но более узко специализированные) программисты, а для CORBA можно задействовать программистов среднего уровня, но чрезвычайно важно иметь квалифицированных архитектора проекта и руководителей групп программистов.

Взаимодействие с другими технологиями
COM
COM является достаточно замкнутой и "самодостаточной" системой. В последнее время Microsoft тесно взаимодействует с OMG на базе создания спецификации моста "COM-CORBA". Вследствие существенных различий в возможностях, не представляет труда имитировать поведение COM-объекта как CORBA-объекта, но не наоборот.  
CORBA
CORBA как технология в настоящий момент (до создания спецификаций, а затем и реализаций своей компонентной модели) является скорее инфраструктурой для создания распределенных систем. Не удивительно, что в этом качестве она активно взаимодействует с другими технологиями - в первую очередь с RMI и Enterprise JavaBeans. CORBA очень тесно - на уровне протокола ESIOP - взаимодействует с широко используемой, но морально устаревшей технологией DCE.  
Выводы
CORBA является существенно более открытой, универсальной и гибкой системой, чем COM. И COM, и CORBA способны тесно и эффективно взаимодействовать со стандартными средствами обеспечения безопасности.

Общие выводы
Несмотря на внешнюю похожесть, что вызвано общностью решаемых задач, между COM и CORBA, пожалуй, больше различий, чем сходства. В большинстве случаев либо нецелесообразно использовать CORBA (для небольших и простых проектов под Windows просто по причине относительно высоких затрат на приобретение программного обеспечения, лицензий и пр.), либо практически невозможно использовать COM (для сложных, масштабируемых, высоконадежных проектов или просто при работе в гетерогенных средах, а не только в Windows). Windows-приложения, ориентированные на взаимодействие с Microsoft Office, всегда будут использовать COM; проекты с использованием Java и любых Java-технологий (кроме Microsoft J++), как говорится, "сам бог велел" строить на основе CORBA. Во многих случаях выбор технологии диктует выбор той или иной части проекта: если вы планируете работать, например, с ORACLE 8i, то, безусловно, гораздо лучше ориентироваться на CORBA. Область, где эти технологии реально конкурируют, на мой взгляд, очень невелика.
Как нетрудно заметить, автор настоящего обзора является сторонником CORBA, чего и желает всем своим читателям.
За дополнительной информацией обращайтесь в Interface Ltd.

Взято с

Ссылки на сайты по Дельфи

Ссылки на сайты по Дельфи

программистский портал с большим разделом Дельфи

программистский портал с большим разделом Дельфи

Borland Russia
На сервере новости для разработчиков ПО на Delphi. Полное описание свойств Delphi 4. Полезные ссылки на ресурсы Delphi в Интернет. "Лидер на рынке RAD-инструментов" и "Delphi снова побеждает! " - это лозунги с этого сайта.

Torry's Delphi Pages
Сайт для программистов на Delphi. На сайте документация, компоненты, приложения, разработанные на Delphi, примеры программных кодов, файлы для загрузки, новости и ссылки на ресурсы Delphi в Интернет. Самая большая коллекция компоентов

- 'Королевство Дельфи' - Виртуальный клуб программистов. Сайт для программистов пишущих на Delphi, организация взаимопомощи и общение программистов на тему задач на Delphi

- Мастера Дельфи. Большое количество статей и материалов.

Stack Overflow, Runtime error 202

Stack Overflow, Runtime error 202

Simply put, stack overflows are caused by putting too much on the
stack. Usually, they are caused by recursive procedures that never
end. A good example would be creating an event handler for the TMemo's
onChange event, and making a change to the Memo during the processing
of the event. Every time the OnChange event gets fired, another change
is made, so the OnChange event gets fired again in an almost endless
loop. The loop finally ends when the stack overflows, and the
application crashes.

Here is an example of a recursive procedure:

procedure RecursiveBlowTheStack;
begin
  RecursiveBlowTheStack;
end;

Sometimes, a stack overflow is caused by too many large procedures.
Each procedure calls another procedure, until the stack simply
overflows. This can be remidied by breaking up large procedures into
smaller ones. A good rule of thumb in regard to a procedures size is
if the procedure's source code takes up more than a screen, its time
to break it down into smaller procedures.

Finally, stack overflows can be caused by creating very large local
variables inside a procedure, or passing a large variable by value to
another procedure. Consider the passing of string variables. If the
string is 255 characters (plus the length byte), if passed by value,
you are actually taking up 256 bytes off the stack. If the procedure
you are calling passes the string by value to yet another procedure,
the string now takes 512 bytes of stack space. Passing the string (or
other variable) as a var or const parameter takes only 4 bytes, since
var and const parameters are simply pointers to the actual data. You
can also create large variables on the heap by dynamic allocation of
the memory;

The following code demonstrates two procedures BlowTheStack(), and
NoBlowTheStack(). The BlowTheStack procedure attempts to allocate a
large local variable designed to be large enough to crash the
application. The NoBlowTheStack() procedure allocates the same large
variable but allocates it on the heap so the function will succeed.

type
  PBigArray = ^TBigArray;
{$IFDEF WIN32}
  TBigArray = array[0..10000000] of byte;
{$ELSE}
  TBigArray = array[0..64000] of byte;
{$ENDIF}

procedure BlowTheStack;
var
  BigArray : TBigArray;
begin
  BigArray[0] := 10;
end;

procedure NoBlowTheStack;
var
  BigArray : PBigArray;
begin
  GetMem(BigArray, sizeof(BigArray^));
  BigArray^[0] := 10;
  FreeMem(BigArray, sizeof(BigArray^));
end;

Finally, the following code demonstrates creating procedures that
accept large variables as parameters. The PassByValueAnCrash()
procedure is designed to crash since the value parameter is too large
for the stack. The PassByVar(), PassByPointer(), and PassByConst will
succeed, since these procedures only use 4 bytes of stack space. Note
that you cannot modify a parameter passed as const, as a const
parameter is assumed to be read only.

Example:

procedure PassByValueAnCrash(BigArray : TBigArray);
begin
  BigArray[0] := 10;
end;

procedure PassByVar(var BigArray : TBigArray);
begin
  BigArray[0] := 10;
end;

procedure PassByPointer(BigArray : PBigArray);
begin
  PBigArray^[0] := 10;
end;

procedure PassByConst(const BigArray : TBigArray);
begin
  ShowMessage(IntToStr(BigArray[0]));
end;

Стандарт СОМ

Стандарт СОМ

Продолжаем, осталось совсем немного, чтобы подогнать под стандарт COM.
Какой у нас пробел еще остался? Представте, что кто-то сделал так:

var 
   Calc:ICalc;
   Calc2:ICalc2;
begin
   CreateObject(ICalc,Calc);
   Calc.QueryInterafce(ICalc2,Calc2)
   ... 
   Calc.Release;  //объект уничтожается
   i:=Calc2.Mult;  //Облом! Объекта уже нет.
 ...
end;

Не очень хорошо, не правда ли? Нужно все-таки сохранить объект, пока им кто-то пользуется. Очевидное решение - подсчет ссылок. То есть, если у нашего объекта попросили интерфейс, мы увеличим счетчик, если кому-то интерфейс больше не нужен, мы ументьшим счетчик, и как только он обратиться в 0 мы уничтожим объект. Вот и настала пора, имплементировать последние два метода в интерфейса IUnknown. Вначале, добавим счетчик в наш объект:

MyCalc=class(TObject,ICalc,ICalc2) 
   fx,fy:integer;
   FRrefCount:LongInt; //вот он!
public
   procedure SetOperands(x,y:integer); 
   function Sum:integer;
   function Diff:integer;
   function Divide:integer;
   function Mult:integer;
   procedure Release;
   function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
   function _AddRef:Longint; stdcall;
   function _Release:Longint; stdcall;
end;

и имплементируем методы:

function MyCalc._AddRef:Longint;
begin
  Result := InterlockedIncrement(FRefCount);
end;

function MyCalc._Release:Longint;
begin
   Result := InterlockedDecrement(FRefCount);
   if Result = 0 then
     Destroy;
end;

Именно так, как правило, выглядят эти два метода в реализациях под Windows. Теперь в нашем интерфейсе Release не нужен, и можно его оттуда выкинуть. Итак, клиент должен вызывать Release для того, чтобы дать объекту знать, что он его больше не будет использовать, а кто должен вызывать AddRef? Во-первых, мы сами, всегда, когда клиент получает от нас интерфейс. Если бы мы не писали на Delphi, это надо было бы делать в методе QueryInterface, однако в Delhpi метод GetInterface класса TObject сам вызывает AddRef, так что нам заботиться об этом не надо. Надо сказать, что и клиент может вызвать AddRef, ecли по каким-то причинам, не желает чтобы объект исчез из памяти. Но тут уж вся ответсвенность на нем.
Надо сказать еще об одной особенности Delphi, касательно использования COM объектов(а точнее интерфейсов) в своих приложениях. Как было упомянуто выше, клиент должен вызывать Release для того, чтобы объект знал, когда ему можно удалиться. Так вот для переменных типа interface Delphi сам вызывает Release, если переменная уничтожается или если ей присваивается nil. То есть:

var
  ifc:IUnknown;
begin
  ifc:=SomeComObj.QueryInterface(IUnknown,ifc); 
  ...
  ifc:=nil; //здесь вызывается ifc._Release
end;

var
  ifc:IUnknown;
begin
  ifc:=SomeComObj.QueryInterface(IUnknown,ifc);
  ...
end; //теперь где-то здесь ifc._Release (перед уничтожением ifc).

Так что всегла имейте это ввиду: как минимум один раз Release будет вызван без вашего указания.

var
  ifc:IUnknown;
begin
  ifc:=SomeComObj.QueryInterface(IUnknown,ifc);
  ifc._Release;
end; //Access violation! Объекта уже нет и вызов ifc._Release проваливается!

Ну вот у нас теперь практически полноценный COM объект. Чем же он еще не полноценен? Наверно вы уже догадались - он не универсален с точки зрения системы. То есть создать его можно лишь подключив загрузив вручную нашу dll и вызвав CreateObject. Но ведь в Windows есть возможность вызывать СOM объекты даже просто по имени! Как это делается? Понятно, что в системе существует правило, как создавать COM объекты. И если мы хотим, чтобы система знала как слздать наш MyCalc, мы должны сделать его по этим правилам. Именно этим мы и займемся.

Но в начале, небольшое резюме.
Итак СOM - это битовый стандарт, то есть он обеспечивает совместимость на битовом уровне. С СOM объектами работают через их интерфейсы. Интерфейс - это таблица методов, указатель на которую мы можем получить у объекта. Каждый СОМ объект имплементирует интерфейс IUnknown, который содержит три метода: QueryInterface, AddRef и Release (это стандартные имена, но в принципе вы можете дать любые. Так как совмещение идет на битовом уровне, то важен лишь порядок в котором расположенны эти методы в таблице, а так же тип метода(набор параметров, тип возвращаемого значения, тип вызова)). Все интерфейсы должны быть потомками IUnknown, то есть у каждого интерфейса первые три метода это QueryInterface, AddRef и Release. Интерфейсы индифецируются GUID. Для того, чтобы получить у объекта какой-то интерфейс, нужно знать его(интерфейса) GUID. То есть название интерфейса неважно для COM - оно исползуется для удобства людей. Вы можете назвать его IMyInterface, но если его GUID равен {00000000-0000-0000-C000-000000000046}, то все в COM'e (случайная игра слов) будут думать, что это IUnknown.

Ну вот в основном все, пойдем дальше.

Статьи

Статьи

В данной базе знаний я постарался собрать не только вопросы и ответы, но так же какое-то количество статей, которые показались мне весьма интересными для разработчиков на Дельфи:

Среда Дельфи
   


Язык программирования Дельфи
   


VCL
   
   
   
   
   


Железо
   
   


Система
   
   
   
   
   
   
   


Базы данных
   
   
   
   
   
   
   
   


Файлы
   
   


Печать и репортинг
   


Интернет, сети, протоколы
   
   
   
   
   
   
   
   
   
   
   


Графика, звук и видео
   
   


Математика и алгоритмы
   
   
   


ActiveX, COM, DCOM, MIDAS, CORBA, интерфейсы, OLE, DDE
   
   
   
   
   
   
   
   


Разработка приложений
   
   
   


Kylix
   
   
   
   
   
   
   
   


.NET
   
   

Статическая и динамическая загрузка DLL

Статическая и динамическая загрузка DLL

DLL возможно загружать двумя способами:

- статически
- динамически


Давайте создадим простую библиотеку DLL:

Project file name: c:\example\exdouble\exdouble.dpr

library ExDouble; 
// my simple dll 

function calc_double ( r: real ): real; stdcall; 
begin 
     result := r * 2; 
end; 

exports 
  calc_double index 1; 

end; 


Теперь посмотрим, как её можно загружать:


СТАТИЧЕСКАЯ ЗАГРУЗКА DLL
==================

При таком способе загрузки достаточно поместить файл DLL в директорию приложения или в директорию Windows, или в Windows\System, Windows\Command. Однако, если система не найдёт этого файла в этих директория, то высветится сообщение об ошибке (DLL не найдена, или что-то в этом духе).

unit untMain; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 

type 
  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

function calc_double ( r: real ): real; stdcall; external 'ExDouble.dll'; 

{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject); 
begin 
     // в окошке сообщения будет цифра 21
     showMessage ( floatToStr ( calc_double ( 10.5 ) ) ); 
end; 

end. 

ДИНАМИЧЕСКАЯ ЗАГРУЗКА DLL
===================

При динамической загрузке требуется написать немного больше кода.


А вот как это выглядит:
----------------------------------------------------------------------

unit untMain; 

interface 

uses 
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, 
  StdCtrls; 

type 
  Tcalc_double = function  ( r: real ): real; 

  TForm1 = class(TForm) 
    Button1: TButton; 
    procedure Button1Click(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
  end; 

var 
  Form1: TForm1; 

implementation 

{$R *.DFM} 

procedure TForm1.Button1Click(Sender: TObject); 
var 
   hndDLLHandle: THandle; 
   calc_double: Tcalc_double; 
begin 
     try 
        // загружаем dll динамически
        hndDLLHandle := loadLibrary ( 'ExDouble.dll' ); 

        if hndDLLHandle <> 0 then begin 

           // получаем адрес функции
           @calc_double := getProcAddress ( hndDLLHandle, 'calc_double' ); 

           // если адрес функции найден
           if addr ( calc_double ) <> nil then begin 
              // показываем результат ( 21...) 
              showMessage ( floatToStr ( calc_double ( 10.5 ) ) ); 
           end else 
              // DLL не найдена ("handleable") 
              showMessage ( 'Function not exists...' ); 

        end else 
           // DLL не найдена ("handleable") 
           showMessage ( 'DLL not found...' ); 

     finally 
        // liberar 
        freeLibrary ( hndDLLHandle ); 
     end; 
end; 

end. 

Взято с Исходников.ru

Статистика и теория вероятности

Статистика и теория вероятности

Cодержание раздела:





См. также статьи в других разделах:

---

---