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

ВИДЕОКУРС ВЗЛОМ
выпущен 2 сентября!


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

БОЛЬШОЙ FAQ ПО DELPHI



Как создать таблицу базы данных, не используя Database Desktop 2


 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;
 




Как создать таблицу базы данных, не используя Database Desktop 3


 uses DB, 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;
 




Как создать таблицу базы данных, не используя Database Desktop 4


 // Создание 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;
 




Создавать таблицы такой же структуры

Автор: Nomadic

В 1995 годy на компьютеpной выставке CeBIT в Ганновеpе во вpемя доклада Билла Гейтса в зале поднимали плакат "Alt+F4".

Удобней всего, напpимеp, так


 with bmovMyBatchMove do
 begin
   Mode := bmCopy;
   RecordCount := 1;
   Execute;R Destination.Delete;
 end;
 

Где bmovMyBatchMove - экземпляр класса TBatchMove из VCL.

Hеправда Ваша! ;)

Этот загадочный BatchMove имеет одну очень неприятную особенность (по крайней мере при работе с DBF-таблицами и в Delphi 1.0x), как-то:

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

Я эту особенность побороть не сумел, а мириться с ней в условиях нашей конторы (когда приходится бороться за место под солнцем с программистами на Clipper и FoxPro совершенно неприемлемо.

Кроме того, в предложенном выше варианте еще и запись удалять приходится...:)

Решалась же эта проблема следующим способом:


 procedure CopyStruct(SrcTable, DestTable: TTable; cpyFields: array of string);
 var
   i: Integer;
   bActive: Boolean;
   SrcDatabase, DestDatabase: TDatabase;
   iSrcMemSize, iDestMemSize: Integer;
   pSrcFldDes: PFldDesc;
   CrtTableDesc: CRTblDesc;
   bNeedAllFields: Boolean;
 begin
   SrcDatabase := Session.OpenDatabase(SrcTable.DatabaseName);
   try
     DestDatabase := Session.OpenDatabase(DestTable.DatabaseName);
     try
       bActive := SrcTable.Active;
       SrcTable.FieldDefs.Update;
       iSrcMemSize := SrcTable.FieldDefs.Count * SizeOf(FLDDesc);
       pSrcFldDes := AllocMem(iSrcMemSize);
       if pSrcFldDes = nil then
       begin
         raise EOutOfMemory.Create('Не хватает памяти!');
       end;
       try
         SrcTable.Open;
         Check(DbiGetFieldDescs(SrcTable.Handle, pSrcFldDes));
         SrcTable.Active := bActive;
         FillChar(CrtTableDesc, SizeOf(CrtTableDesc), 0);
         with CrtTableDesc do
         begin
           StrPcopy(szTblName, DestTable.TableName);
           StrPcopy(szTblType, 'DBASE');
           if (Length(cpyFields[0]) = 0) or (cpyFields[0] = '*') then
           begin
             bNeedAllFields := True;
             SrcTable.FieldDefs.Update;
             iFldCount := SrcTable.FieldDefs.Count;
           end
           else
           begin
             bNeedAllFields := False;
             iFldCount := High(cpyFields) + 1;
           end;
           iDestMemSize := iFldCount * Sizeof(FLDDesc);
           CrtTableDesc.pFLDDesc := AllocMem(iDestMemSize);
           if CrtTableDesc.pFLDDesc = nil then
           begin
             raise EOutOfMemory.Create('Не хватает памяти!');
           end;
         end;
         try
           if bNeedAllFields then
           begin
             for i := 0 to CrtTableDesc.iFldCount - 1 do
             begin
               Move(PFieldDescList(pSrcFldDes)^[i],
                 PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
             end;
           end
           else
           begin
             for i := 0 to CrtTableDesc.iFldCount - 1 do
             begin
               Move(PFieldDescList(pSrcFldDes)^[SrcTable.FieldDefs.Find(cpyFields[i]).FieldNo - 1],
                 PFieldDescList(CrtTableDesc.pFLDDesc)^[i], SizeOf(FldDesc));
             end;
           end;
           Check(DbiCreateTable(DestDatabase.Handle, True, CrtTableDesc));
         finally
           FreeMem(CrtTableDesc.pFLDDesc, iDestMemSize);
         end;
       finally
         FreeMem(pSrcFldDes, iSrcMemSize);
       end;
     finally
       Session.CloseDatabase(DestDatabase);
     end;
   finally
     Session.CloseDatabase(SrcDatabase);
   end;
 end;
 




Динамическое создание таблицы и полей во время выполнения программы

Delphi в режиме разработки позволяет быстро добавлять и настраивать в вашем проекте компоненты для работы с базами данных, но есть ситуации, когда вам нужно создавать и конфигурировать объекты во время выполнения программы. Например, во время выполнения программы вам может понадобиться добавить колонку с вычисляемым полем (используя алгоритмы пользователя). Поэтому вопрос: как, не используя среды разработки, Инспектора Объектов и редактора TFields, создавать и сконфигурировать TField и другие компоненты для связки данных?

В следующем примере показано динамическое создание TTable, таблицы базы данных в связке с TTable, TFieldDefs, TFields, вычисляемых полей и подключение обработчика для события OnCalc.

Для начала выберите пункт New Application меню File. Будет создан новый проект с пустой формой, на которой мы и будет создавать на лету наши компоненты.

В секцию interface вашего модуля формы добавьте, как показано ниже, объявление обработчика события OnCalcFields и поля TaxAmount. Позже мы создадим TTable и назначим этот обработчик событию TTable OnCalcFields, который позволит при чтении каждой записи вызывать событие OnCalcFields, которое, в свою очередь, выполнит нашу процедуру TaxAmountCalc.


 type
   TForm1 = class(TForm)
     procedure TaxAmountCalc(DataSet: TDataset);
   private
     TaxAmount: TFloatField;
   end;
 

В секции implementation создайте обработчик события OnCalc как показано ниже:


 procedure TForm1.TaxAmountCalc(DataSet: TDataset);
 begin
   Dataset['TaxAmount'] := Dataset['ItemsTotal'] *
     (Dataset['TaxRate'] / 100);
 end;
 

Создайте обработчик формы OnCreate как показано ниже (для получения дополнительной информации о создании обработчиков событий обратитесь к Delphi Users Guide, Chapter 4 "Working With Code").


 procedure TForm1.FormCreate(Sender: TObject);
 var
   MyTable: TTable;
   MyDataSource: TDataSource;
   MyGrid: TDBGrid;
 begin
   { Создаем компонент TTable -- связанная
   таблица базы данных будет создана ниже. }
   MyTable := TTable.Create(Self);
   with MyTable do
   begin
 
     { Определяем основную базу данных и таблицу.
     Примечание: Test.DB пока не существует. }
     DatabaseName := 'DBDemos';
     TableName := 'Test.DB';
 
     { Назначаем TaxAmountCalc обработчиком события,
     чтобы использовать его при наступлении события
     OnCalcFields в MyTable. }
     OnCalcFields := TaxAmountCalc;
 
     { Создаем и добавляем определения полей к массиву TTable
     FieldDefs, затем создаем TField с использованием
     информации из определения поля. }
     with FieldDefs do
     begin
       Add('ItemsTotal', ftCurrency, 0, false);
       FieldDefs[0].CreateField(MyTable);
       Add('TaxRate', ftFloat, 0, false);
       FieldDefs[1].CreateField(MyTable);
       TFloatField(Fields[1]).DisplayFormat := '##.0%';
 
       { Создаем вычисляемое TField, назначаем свойства,
       и добавляем поле к массиву определений MyTable. }
       TaxAmount := TFloatField.Create(MyTable);
       with TaxAmount do
       begin
         FieldName := 'TaxAmount';
         Calculated := True;
         Currency := True;
         DataSet := MyTable;
         Name := MyTable.Name + FieldName;
         MyTable.FieldDefs.Add(Name, ftFloat, 0, false);
       end;
     end;
 
     { Создаем в базе данных новую таблицу,
     используя в качестве основы MyTable. }
     MyTable.CreateTable;
   end;
 
   { Создаем компонент TDataSource
   и назначаем его MyTable. }
   MyDataSource := TDataSource.Create(Self);
   MyDataSource.DataSet := MyTable;
 
   { Создаем табличную сетку, отображаем
   на форме, и назначаем MyDataSource для
   получения доступа к данным из MyTable. }
   MyGrid := TDBGrid.Create(Self);
   with MyGrid do
   begin
     Parent := Self;
     Align := alClient;
     DataSource := MyDataSource;
   end;
 
   { Запускаем нашу конструкцию! }
   MyTable.Active := True;
   Caption := 'Новая таблица ' + MyTable.TableName;
 end;
 

Ниже приведен полный исходный код проекта:


 unit gridcalc;
 
 interface
 
 uses
 
   Windows, Messages, SysUtils, Classes, Graphics, Controls,
   Forms, Dialogs, Grids, DBGrids, ExtCtrls, DBCtrls, DB,
   DBTables, StdCtrls;
 
 type
 
   TForm1 = class(TForm)
     procedure FormCreate(Sender: TObject);
     procedure TaxAmountCalc(DataSet: TDataset);
   private
     TaxAmount: TFloatField;
   end;
 
 var
 
   Form1: TForm1;
 
 implementation
 
 {$R *.DFM}
 
 procedure TForm1.TaxAmountCalc(DataSet: TDataset);
 begin
 
   Dataset['TaxAmount'] := Dataset['ItemsTotal'] *
     (Dataset['TaxRate'] / 100);
 end;
 
 procedure TForm1.FormCreate(Sender: TObject);
 var
 
   MyTable: TTable;
   MyDataSource: TDataSource;
   MyGrid: TDBGrid;
 begin
 
   MyTable := TTable.Create(Self);
 
   with MyTable do
   begin
     DatabaseName := 'DBDemos';
     TableName := 'Test.DB';
     OnCalcFields := TaxAmountCalc;
 
     with FieldDefs do
     begin
       Add('ItemsTotal', ftCurrency, 0, false);
       FieldDefs[0].CreateField(MyTable);
       Add('TaxRate', ftFloat, 0, false);
       FieldDefs[1].CreateField(MyTable);
       TFloatField(Fields[1]).DisplayFormat := '##.0%';
       TaxAmount := TFloatField.Create(MyTable);
 
       with TaxAmount do
       begin
         FieldName := 'TaxAmount';
         Calculated := True;
         Currency := True;
         DataSet := MyTable;
         Name := MyTable.Name + FieldName;
         MyTable.FieldDefs.Add(Name, ftFloat, 0, false);
       end;
     end;
     MyTable.CreateTable;
   end;
 
   MyDataSource := TDataSource.Create(Self);
   MyDataSource.DataSet := MyTable;
   MyGrid := TDBGrid.Create(Self);
 
   with MyGrid do
   begin
     Parent := Self;
     Align := alClient;
     DataSource := MyDataSource;
   end;
 
   MyTable.Active := True;
   Caption := 'Новая таблица ' + MyTable.TableName;
 end;
 
 end.
 




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

Объект TTable может быть создан с владельцем, а может и без оного. Поскольку вы объявляете его локально в процедуре, то владелец в этом случае не требуется. Если владелец не задан, то забота об освобождении объекта ложится на вас. В противном случае объект освобождается владельцем всякий раз, когда освобождается сам владелец. Имеет смысл? Чтобы создать таблицу без владельца, сделайте следующее:


 procedure CreateATableInAUnit;
 var
   myTable: TTable;
 begin
   myTable := TTable.Create(nil);
   try
     myTable.DatabaseName := 'MyDB';
     myTable.TableName := 'MyTable.db';
     mytable.IndexName := 'MyIndex';
     myTable.Open;
     {другой код}
   finally
     myTable.Free;
   end;
 end;
 




Создание компонента TTable без формы

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


 FSession := TSession.Create(nil);
 
 FDatabase := TDatabase.Create(nil);
 FSession.SessionName := 'DBSession'
 FDatabase.Connected := False;
 FDatabase.AliasName := Database;
 FDatabase.DatabaseName := USER_DATABASE;
 FDatabase.SessionName  := FSession.SessionName;
 
 
 FUserTBL := TTable.Create(nil);
 FUserTBL.DatabaseName := FDatabase.DatabaseName;
 FUserTBL.SessionName := FSession.SessionName;
 FUserTBL.TableName := USERTBL;
 FUserTBL.IndexName := USERSpIndex;
 
 
 FUserSource := TDataSource.Create(nil);
 FUserSource.DataSet := FUserTBL;
 




Создание компонента TTable без формы 2

Вы можете использовать TTable, не размещая компонент на форме:


 procedure TForm1.TotalPopulation: double;
 var
   Tbl: TTable;
 begin
   Result := 0;
   Tbl := TTable.Create(nil);
   try
     tbl.DatabaseName := 'DBDEMOS';
     tbl.TableName := 'COUNTRY';
     Tbl.Open;
     tbl.First;
     while not Tbl.EOF do
     begin
       Result := Result + Tbl.FieldByName('Population').AsFloat;
       Tbl.Next;
     end;
     Tbl.Close;
   finally
     Tbl.Free;
   end;
 end;
 




Создание компонента TTable без формы 3

Для создания таблицы программным способом вы должны сделать приблизительно следующее:


 with Table1 do
 begin
   Close;
   TableName := 'test.db';
   TableType := ttParadox;
   DatabaseName := 'Sample';
   FieldDefs.Clear;
   {FldName,FldType,FldLength,Required}
   FieldDefs.Add('Field1',ftString,10,false);
   ...
   { Создание первичного индекса }
   IndexDefs.Add('','Field1',[ixPrimary]);
   CreateTable;
 end;
 




Создание компонента TTable без формы 4

Я привожу некоторый код, касающийся описываемой проблемы: он работал, когда я использовал его в большом приложении. Я не знаю специфического метода создания компонента TTable вне родителей, поэтому я пошел путем создания своего класса от TTable во время инициализации модуля. Удобство такого подхода объясняется наличием под рукой всегда готового к работе экземпляра класса, стоит всего-лишь добавить модуль к вашему приложению. Конечно, новый класс не должен иметь одиноко выглядящую процедуру со странной технологией фильтрации данных :=))), да и не помешала бы публикация нескольких событий, но этот пример призван все-го лишь продемонстрировать иной подход к решаемой задаче.


 unit Unit2;
 
 interface
 uses db, DBTables, dialogs;
 
 type
   fake = class(Ttable)
     procedure fakeFilterRecord(DataSet: TDataSet; var Accept: Boolean);
   end;
 
 var
   MyTable: fake;
 
 implementation
 
 procedure fake.fakeFilterRecord(DataSet: TDataSet; var Accept: Boolean);
 begin
   showmessage('Здравствуй, Вася');
 end;
 
 initialization
 
   MyTable := fake.create(nil);
   with Mytable do
   begin
     DataBaseName := 'dbdemos';
     TableName := 'biolife';
     OnFilterRecord := MyTable.fakeFilterRecord;
     Filtered := true;
     active := true;
   end;
 
   {проверка получением неких данных...}
   showmessage(MyTable.fields[1].asstring);
 
 finalization
   {Важно!  MyTable не имеет родителя, - уничтожаем объект сами,
   иначе память не высвобождается...}
   MyTable.free;
 
 end.
 




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

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


 unit Autoinc;
 
 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.
 




Как создать временный Canvas

Создайте Bitmap, и воспользуйтесь свойством холста TBitmap-а, чтобы рисовать на нём. Следующий пример создаёт Bitmap, рисует на его canvas-е, рисует canvas на форме, а затем освобождает bitmap.

Пример:


 procedure TForm1.Button1Click(Sender: TObject);
 var
   bm: TBitmap;
 begin
   bm := TBitmap.Create;
   bm.Width := 100;
   bm.Height := 100;
   bm.Canvas.Brush.Color := clRed;
   bm.Canvas.FillRect(Rect(0, 0, 100, 100));
   bm.Canvas.MoveTo(0, 0);
   bm.Canvas.LineTo(100, 100);
   Form1.Canvas.StretchDraw(Form1.ClientRect, Bm);
   bm.Free;
 end;
 




При попытке создать объект класса TPrinter я получаю exception

В создании обьекта класса TPrinter с использованием TPrinter.Create нет необходимости, так как обьект класса TPrinter (называемый Printer) автоматически создается при использовании модуля Printers.


 uses
   Printers;
 
 procedure TForm1.Button1Click(Sender: TObject);
 begin
   Printer.BeginDoc;
   Printer.Canvas.TextOut(100, 100,
     'Delphi World is the biggest source code collection!');
   Printer.EndDoc;
 end;
 




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

Пример библиотеки:


 library nikelutils
 
 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";
 




Создание уникального поля


 Procedure TableNewRecord(FieldName: String;
  Var DataSet: TDataSet);
 Var
   NumRec: Integer;
   bm: TBookmark;
 Begin
   with DataSet do
   begin
     NumRec := Succ(RecordCount);
     if State = dsInsert then
       Post;
     bm := GetBookMark;
     DisableControls;
     while Locate(FieldName, NumRec, []) and (NumRec >  0) do
       Dec(NumRec);
     if NumRec = 0 then
     begin
       NumRec := RecordCount;
       while Locate(FieldName, NumRec, []) do
         Inc(NumRec);
     end;
     GotoBookmark(bm);
     FreeBookmark(bm);
     Edit;
     FieldByName(FieldName).AsInteger := NumRec;
     Post;
     EnableControls;
   end;
 End;
 




Создание уникального поля 2

Автор: Serg

Вот мой вариант получения очередного уникального (возрастающего) ID

По полю FieldName строится уникальный индекс

Заодно скажу, что использование AutoInc не есть мудрое решение. А если надо пересобрать таблицы ?


 { Get max key value}
 function quGetMaxID_(tbName,FieldName: String): LongInt;
 begin
   with TQuery.Create(nil) do
     try
       DatabaseName := DBname;
       SQL.Add('SELECT MAX('+FieldName+') FROM ' + QuotedStr(tbName));
       Open;
       result := Fields[0].AsInteger + 1;
     finally
       Close;
       Free;
     end;
 end;
 
 { insert new record and return new ID value}
 function quInsertBlankSQL_(tbName,fName: string; var id: Longint): boolean;
 var
   i: integer;
 begin
   Result := False;
   for i:=1 to RepeateAccess do
   begin
     id := quGetMaxID_(tbName,fName);
     Result := quInsertKeySQL_(tbName,fName,id);
     if Result then
       Break;
   end;
 end;
 
 { Insert record for  ID}
 function quInsertKeySQL_(tbName, KeyField: string;
  KeyValue: Longint): boolean;
 var
   i: integer;
   str: string;
 begin
   Result := False;
   str := 'INSERT INTO '+tbName+' ('+ KeyField + ')'+
    ' VALUES ('+IntToStr(KeyValue)+')';
   for i:=1 to gRptAccess do
   begin
     Result := quExecuteSQL_(str);
     if Result then
       Break;
   end;
 end;
 
 function quExecuteSQL_(SQLstring: string): boolean;
 begin
   with quCreateTmp_(SQLstring) do
   begin
     try
       ExecSQL;
       Result := True;
     except
       on E: Exception do
       begin
         Result := False;
       end;
     end;
     Free;
   end;
 end;
 
 function quCreateTmp_(SQLstring: string): TQuery;
 begin
   Result:= TQuery.Create(nil);
   with Result do
   begin
     DatabaseName := DBname;
     SQL.Text := SQLString;
   end;
 end;
 




Создание и использование 256-цветной палитры

Автор: Bob Teller

Вот пример того, как можно создать и использовать палитру для 256-цветных изображений. Вам, вероятно, необходимо использовать API функции SelectPalette и RealizePalette, в зависимости от того как вы хотите использовать ваше изображение.


 procedure TfrmMain.MakePalette(forBitMap: TBitMap);
 var
   pNewPal: PLogPalette;
   lSize: LongInt;
   nCntr: Byte;
 begin
   lSize := SizeOf(TLogPalette) +
     SizeOf(TPaletteEntry) * 256;
   try
     GetMem(pNewPal, lSize);
     pNewPal^.palNumEntries := 256;
     pNewPal^.palVersion := $300;
 {$R-} {выключаем контроль допустимого диапазона}
     {создаем данные палитры...}
     for nCntr := 0 to 254 do
     begin
       pNewPal^.palPalEntry[nCntr].peRed := nCntr + 20;
       pNewPal^.palPalEntry[nCntr].peGreen := nCntr + 20;
       pNewPal^.palPalEntry[nCntr].peBlue := nCntr + 20;
       pNewPal^.palPalEntry[nCntr].peFlags := pc_nocollapse;
     end;
 {$R+} {включаем контроль допустимого диапазона}
     {удаляем старый hPal; предохраняемся от утечки памяти}
     DeleteObject(hPal);
     {создаем новую палитру на основе новых значений}
     hPal := CreatePalette(pNewPal^);
     {назначаем новую палитру}
     forBitMap.Palette := hPal;
   finally
     FreeMem(pNewPal, lSize);
   end;
 end;
 




Создание формы переменного типа

Автор: Mike Orriss

Как насчет этого? (допустим что str содержит 'TForm2' и т.п.)?


 procedure TForm1.Button1Click(Sender: TObject);
 begin
   with TFormClass(FindClass(str)).Create(Application) do
     try
       ShowModal;
     finally
       Free;
     end;
 end;
 
 initialization
   RegisterClasses([TForm2,TForm3,TForm4]);
 end.
 




Создание WebSnap-сервера

Два сисадмина:
- Мне вчера чувак сервер сломал
- Он, что хакер?
- Нет, он м#дак!

WebSnap представляет собой набор компонент, появившийся в Delphi 6 Enterprise и предназначенный для разработки Web-серверных приложений в RAD-среде. В настоящей статье дано краткое описание создания WebSnap-сервера, поддерживающего полный интерфейс редактирования и просмотра для простого набора данных, и включающий поддержку графических полей. Хотя данный WebSnap-сервер является "простым", т.к. не требует написания кода, он, тем не менее, поддерживает полный набор функциональных возможностей для модификации таблиц базы данных с помощью браузера.

Итак, начнем

Создание WebSnap-сервера

Сначала следует вызвать новую панель инструментов WebSnap, с помощью которой будет значительно удобнее создавать WebSnap-приложение. Это можно сделать, щелкнув правой кнопкой мыши по панелям инструментов в интегрированной среде разработки (IDE) Delphi 6 Enterprise и выбрав панель инструментов "Internet". После этого, на экране отобразится следующее:

Первый значок (изображение руки, держащей глобус) используется для создания нового WebSnap-приложения. Если щелкнуть по нему мышью, то на экране отобразится мастер WebSnap. Теперь зададим имя для нашей главной страницы. Кроме того, следует создать приложение Web App Debugger (Отладчик Web-приложений), которое позволит использовать специальный Web-сервер (написанный в Delphi), поставляемый вместе с Delphi 6 Pro и Enterprise. Назовем данный сервер BasicDemo.

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

Создание модуля данных

Теперь создадим модуль данных WebSnap, который можно использовать для публикации информации из набора данных (или нескольких наборов данных, как в нашем случае). WebDataModule можно создать, щелкнув по третьей кнопке (набор данных на фоне глобуса) на панели инструментов WebSnap. После этого поместим компонент TClientDataSet из закладки Data Access в палитре компонентов, и свяжем его с MyBase XML DataSet-версией хорошо известной надежной таблицы Paradox Biolife.db, которая содержит графическое поле и поле комментария, а также числовые и текстовые поля, которые можно публиковать и редактировать с использованием WebSnap.

Поддержка stateless-серверов

После задания имени файла ClientDataSet следует перейти к древовидному представлению (Object Treeview) объектов, раскрыть ClientDataset, щелкнуть мышью по Fields, а затем, щелкнув правой кнопкой мыши, добавить все поля в древовидную структуру. Так как WebSnap используется для построения stateless-серверов, работающих с базами данных, мы должны указать первичный ключ, позволяющий набору данных активизировать навигацию по запросу клиента и манипуляцию данными. WebSnap проделает все это автоматически после того, как мы зададим первичный ключ. В данном случае, используем в качестве первичного ключа Species No. Сначала следует выбрать его в Object Treeview:

Затем необходимо модифицировать свойство ProviderFlags в Object Inspector (инспектор объектов), установив pfInKey на True, чтобы указать, что Species No является первичным ключом для данного набора данных.

Если у Вас нет этого набора данных, можете проделать те же операции с Paradox-таблицей, используя BDE. Единственное отличие заключается в том, что Вам придется явно разместить компонент сессии BDE, установить его свойство AutoSessionName на True, а для указания на таблицу DBDEMOS biolife.db использовать компонент TTable. Все остальные действия должны быть выполнены без изменения.

Отображение данных в браузере

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

и установить DataSetAdapter на DataModule. DataModule должен принять вид, подобный представленному на рисунке:

Затем, используя Object Inspector, следует присоединить адаптер к набору данных. На приведенном ниже рисунке показан Object Inspector, поддерживающий in-line-расширение ссылок на компоненты. Обратите внимание на то, что свойства набора данных выделены разным цветом и представлены с отступом от левого края в Object Inspector.

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




Создание WEB-приложений в среде Delphi

Приз эксгибиционисту от баннерообменной сети: 100000 показов!

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

Время первопроходцев HTML в скором времени закончиться и вовсе, и их место займут профессионалы-программисты. Именно программисты, ибо уже в большей степени от их умения создать удобный в использование сайт зависит его успех. Кроме прочего, теперь сайты создают совсем уж как программные продукты: тем кто занят наполнением содержанием, уже может не опасаться запутаться в html, java, cgi и прочих ипостасях интернет-технологий - администрирование сайта становиться таким же привычным и удобным, как работа с текстовыми процессорами. Пока правда ощущается явный недостаток законченных продуктов, на плечи которых можно было бы возложить все функции по поддержанию сайта в актуальном состоянии, оставив себе лишь вопросы по наполнению его содержанием.

Пока же тяжкое бремя по созданию данных систем, на основе которых будет функционировать сайт, ложиться на плечи программистов, только вот-вот успевших изумится возможностями языка Perl или Java. И многие из них, сказать без преувеличения, вышли, словно из гоголевской "Шинели", из Delphi. Действительно, данная среда разработчика, предоставляющая удобный интерфейс для визуального программирования и широкие возможности Object Pascal, столь мила сердцу российских программистов.

Но, похоже, что времена меняются, и Delphi, из среды создания обычных настольных приложений, может сгодиться и в другом плане: для написания прикладных web-программ. И действительно, что может быть лучше: уже знакомая среда разработки, вдоль и поперек изученный язык, да и достаточно широкий круг специалистов по программированию в Delphi - это ли не плюсы создания web-приложений на Delphi. Есть конечно и минусы: созданные программы вряд ли смогут удовлетворить тех, кто считает, что лучший web-сервер, это сервер не от Microsoft. Но что поделаешь - версия Delphi под Unix отложена пока до лучших времен. Зато посудите сами: перенос программ в будущем светлом будущем можно будет совершить с малой кровью.

Но отложим пока теорию в сторону, и обратимся к практики. Итак, создания web-приложения в среде Delphi, что называется шаг за шагом.

Пример из учебника

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

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

Создайте в Delphi новый проект - ту самую уже давно забытую всем Console Application. Вы получите знакомый со школьной скамьи, текст обычной паскалевской программы:


 program primer;
 {$APPTYPE CONSOLE}
 uses SysUtils;
 
 begin
   // Insert user code here
 end.
 

Далее, еще проще. Организуем вывод кода HTML с помощью команды writeln.


 writeln ('CONTENT-TYPE: TEXT/HTML');
 writeln;
 writeln ('<html>');
 writeln ('<head>');
 writeln ('<meta HTTP-EQUIV="Content-Type" Content="text-html; charset=windows-1251">');
 writeln ('<title>Delphi the best facility for making web-publications!</title>');
 writeln ('</head>');
 writeln ('<body bgcolor="white">');
 writeln ('Hello, world!');
 writeln ('</body>');
 writeln ('</html>');
 

Обратите внимание на строку CONTENT-TYPE: TEXT/HTML, которая определяет описание последующего содержимого, а именно кода HTML. После CONTENT-TYPE: TEXT/HTML, необходимо вывести пустую строку иначе броузер может выдать сообщение об ошибке.

Теперь, когда приложение закончено, осталось его скомпилировать и проверить. Для проверки работоспособности программы вам понадобиться веб-сервер. Можно особо не утруждаться, подойдет любой, даже стандартный домашний веб-сервер от Microsoft. Приложение надо будет разместить в папке публикаций сервера (обычно это - C:\Inetpub\ wwwroot) и запустить сам сервер. Теперь, если вы перейдете по адресу http://localhost/primer.exe в броузере, вы должны увидеть результат действия данной программы - строку Hello, world! Вот и всё, простейшее web-приложение на Delphi готово.

Передача параметров

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

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


 program CgiDate;
 {$APPTYPE CONSOLE}
 uses SysUtils;
 
 begin
   writeln ('CONTENT-TYPE: TEXT/HTML');
   writeln;
   writeln ('<HTML><HEAD>');
   writeln ('<TITLE>Cgidate</TITLE>');
   writeln ('</HEAD><BODY>>');
   writeln ('<H1>Пример передачи параметров</H1>');
   writeln ('<HR>');
   writeln ('<H4>
 
   if ParamCount >0 then
   begin
     if ParamStr (1) = 'date' then
       writeln (FormatDateTime('"Сегодня " dddd, mmmm d, yyyy', Now))
     else
     if ParamStr (1) = 'time' then
       writeln (FormatDateTime('"Время" hh:mm:ss AM/PM', Now))
     else
     if ParamStr (1) = 'both' then
       writeln (FormatDateTime('"Сегодня " dddd, mmmm d, yyyy,'
       + '"<p> и время" hh:mm:ss AM/PM', Now))
     else
       writeln ('Ошибка! Неверный параметр: ' + ParamStr (1) + '.')
   end
   else
     writeln ('Параметр отсутствует.');
   writeln ('</BODY></HTML>');
 end.
 

Не правда ли просто? Теперь, если в адресной строке броузера вы наберете, например http://localhost/cgidate/exe?time, будет сгенерирована страница отображающая текущее время, http://localhost/cgidate/exe?date - соответственно дата, а при передачи параметра both - текущая дата и время. В случае если никакой из параметров передан не был или он был ошибочен - возникнет сообщение об этом.

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

Следует обратить внимание на то, как передавать данные через url. Знак вопроса отделяет параметр от адреса файла, с помощью знака равенства web-приложению передается значение данного параметра. Так как в адресной строке нельзя использовать пробел, он заменяется на шестнадцатеричный код в таблице ASCII, то есть %20.

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

Для начала естественно нужно создать сам код HTML в котором бы присутствовала форма с полями ввода, кнопкой отправки и прочими необходимыми атрибутами. При этом form action должен содержать адрес программы, которая будет получать данные. Значение method может быть равно как GET, так и POST. На самом деле GET - это и есть передача параметров через url, добавляя их к адресной строке, так как POST передает их приложению посредством стандартного потока ввода. Какой из них лучше и удобней решать вам, но чаще всего метод GET использует именно для генерации страниц (достаточно взглянуть на url который возникает при работе на поисковых серверах), так как второй для передачи данных, отображать которые в адресной строке было бы весьма накладно.

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

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

Гюльчитай, открой личико

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

Итак, данные от пользователя web-приложению, можно передать через переменные окружения. Вот список наиболее часто употребляемых:

GATEWAY_INTERFACE
Поддерживаемая версия CGI.
REQUEST_METHOD
Метод запроса, может быть как GET так и POST.
HTTP_REFERER
Адрес страницы (url), активирующей текущее приложение на web-сервере.
PATH_INFO
Путь переданный приложению расположенный между именем приложения и строкой запроса.
QUERY_STRING
Строка запроса, если метод - GET, добавляеться к url.
REMOTE_HOST
Имя хоста удаленного пользователя.
REMOTE_USER
Имя удаленного пользователя.
REMOTE_IDENT
IP-адрес удаленного пользователя.
HTTP_USER_AGENT
Имя и версия броузера удаленного пользователя.

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

Но вернемся к поставленной задаче - передаче данных приложению от пользователя через форму. Данные, которые передаться через QUERY_STRING в приложение с помощью метода POST достаточно просто извлечь для использования.

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


 program CgiVars;
 {$APPTYPE CONSOLE}
 uses Windows;
 
 сonst
   VarList: array [1..17] of string [30] =
   ('SERVER_NAME', 'SERVER_PROTOCOL',
   'SERVER_PORT', 'SERVER_SOFTWARE',
   'GATEWAY_INTERFACE', 'REQUEST_METHOD',
   'PATH_TRANSLATED', 'HTTP_REFERER',
   'SCRIPT_NAME', 'PATH_INFO',
   'QUERY_STRING', 'HTTP_ACCEPT',
   'REMOTE_HOST', 'REMOTE_USER',
   'REMOTE_ADDR', 'REMOTE_IDENT',
   'HTTP_USER_AGENT');
 
 var
   I: Integer;
   ReqVar: string;
   VarValue: array [0..200] of Char;
 
 begin
   writeln('Content type: text/html');
   writeln;
   writeln('<HTML><HEAD>');
   writeln('<TITLE>CGI Variables</TITLE>');
   writeln('</HEAD><BODY>');
   writeln('<H1>CGI Variables</H1>');
   writeln('<HR><PRE>');
 
   for I := Low (VarList) to High (VarList) do
   begin
     ReqVar := VarList[I];
     if (GetEnvironmentVariable (PChar(ReqVar),
     VarValue, 200) > 0) then
     else
       VarValue := '';
     writeln (VarList[I] + ' = ' + VarValue);
   end;
   writeln('</PRE></BODY></HTML>');
 end.
 

За кадром

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

Для создания полномасштабных приложений для интернета, в Delphi существует специальный помощник - Web Server Application. С его помощью можно создать

приложение генерируемое динамические web-страницы, основанные на CGI, NSAPI или ISAPI. Единственное накладываемое ограничение - непосредственно web-сервер должен работать на базе Windows.

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




Создание WEB-сервера

Женщины как вeб-сервера:
400 Bad Request - свидание без букета
401 Unauthorized - замужем
402 Payment Required - ужин при свечах
403 Forbidden - руки прочь!
404 Not Found - сегодня я гуляю с подругами
405 Method Not Allowed - Не-е, не с зади...
406 Method Not Acceptable - ...только не сосать!
407 Proxy Auth. Required - надо спросить маму
408 Request Timeout - знаешь колько ты уже не звонил?
409 Conflict - что это там была, за блондинка вчера?
410 Document Removed - хочу развода
411 Lenght Required - что? это ты называешь длинным?
412 Precondition Failed - что? у тебя нет презерватива?
413 Request Entity Too Large - Такой не влезит!
415 Unsupported Media Type - нее, вчетвером не интерестно.
500 Internal Server Error - месячные
501 Not Implemented - ещё никогда не пробовала
502 Bad Gateway - ...фу, солёно!
503 Service Unavailable - голова болит
504 Gateway Timeout - это уже всё?

В последнее время возможность управления приложением при помощи WEB интерфейса становится все более популярной. Лично я применил возможность удаленного управления в ряде своих программ, и это существенно упростило их сопровождение в условиях большой организации. Delphi содержит достаточно мощные компоненты, позволяющие легко организовывать соединения по протоколу TCP/IP. Это компоненты TServerSocket и TClientSocket. Для организации WEB сервера нам потребуется только TServerSocket. Для доступа к нашему серверу применим порт с номером 5000 (напоминаю, что порты с номерами меньше 1024 могут использоваться только по назначению и есть опасность, что на Вашей машине будет установлено некоторое приложение, использующее стандартный порт HTTP 80). При этом URL будет выглядеть как machine:5000/path при доступе из сети или 127.0.0.1:5000/path при доступе с локального хоста. Следует сразу поговорить о двух тонкостях, не имеющих прямого отношения к написанию WEB сервера

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

Решением всех этих проблем может послужить следующий совет: никогда не ставьте свойство Active:= true; во время дизайна !! Активируйте компонент TServerSocket при старте программы в конструкции try ... except; Итак, мы поговорили об общих вопросах. Теперь следует поговорить о протоколе HTTP.

Протокол HTTP - краткая справочная информация. Обмен по протоколу HTTP производится в т.н. транзакциях, которые состоят из трех шагов

  1. Установка соединения. Производится по инициативе клиента и для этого необходимо знать порт, по которому работает сервер.
  2. Запрос клиента. Клиент передает серверу HTTP запрос (содержащий HTTP метод, идентификатор ресурса и версию протокола) + дополнительную информацию. Пример типового запроса "GET /book/index.htm HTTP/1.0". Запрос как правило завершается пустой строкой и обязательным CRLF. Вот полный пример запроса IE5 (перехваченный кстати при помощи примера 2):

 GET /btn7.gif HTTP/1.1
 Accept: */*
 Referer: http://127.0.0.1:5000/
 Accept-Language: ru
 Accept-Encoding: gzip, deflate
 User-Agent: Mozilla/4.0 (compatible; MSIE 5.0; Windows 98; DigExt)
 Host: 127.0.0.1:5000
 Connection: Keep-Alive
 

  1. Ответ сервера. Сервер в ответ выдает HTTP ответ + дополнительные данные + запрошенную инфомацию (если требуется). Ответ сервера всегда состоит из строки с версией протокола HTTP, пробела, трехзначного кода статуса, за которым через пробел может следовать его расшифровка. После этого передается CRLF (символов с кодами 0Dh, 0Ah), затем идет необязательная информационная часть в формате параметр=значение и наконец завершается ответ еще одной парой символов CRLF. Затем следует запрошенная информация (если ее передача возможна и требуется в данном контексте). Пример ответа - "НТТР/1.0 200 OK". 4. Сервер разрывает соединение с клиентом, что служит сигналом к завершению обмена Клиент тоже может прервать обмен на любой стадии, разорвав соединение с сервером. Особенно это любит делать IE. Он выдает запрос, получает ответ и начинает получать данные, а тем временем анализируя полученный ответ выясняет, что запрошенный ресурс уже есть в кеше и его не требуется загружать. При этом IE разрывает соединение и прерывает загрузку. Аналогично он ведет себя при нажатии кнопки "Стоп". Поэтому при начальном тестировании я бы рекомендовал использовать программу Net Vampire, которая отображает подробный протокол обмена с сервером (что и когда передано на сервер и что принято в ответ).

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

  • 1** Информационная. На данный момент зарезервирована
  • 2** Успешно. Сообщает об успешном выполнении запроса
  • 3** Перенаправление. Указывает клиенту, что для выполнения запроса необходимы дополнительные действия
  • 4** Ошибка клиента. Сообщает клиенту о том, что запрос неполный или содержит синтаксические ошибки. Кроме того, ошибки этой категории возникают, если запрошенный ресурс не найден или недоступен
  • 5** Ошибка сервера. Возникает, если сервер перегружен, недоступен или в работе сервера возникли какие либо ошибки

Наибольший интерес представляют собой следующие коды (они наиболее распространены)

  • 200 ОК
  • 201 Успешная команда POST
  • 202 Запрос принят
  • 203 Запрос GET либо HEAD выполнен
  • 204 Запрос выполнен, но нет содержимого
  • 300 Ресурс обнаружен в нескольких местах
  • 301 Ресурс удален навсегда
  • 302 Ресурс временно удален
  • 304 Ресурс изменен
  • 400 Плохой запрос от клиента
  • 401 Неавторизованный запрос
  • 402 Необходима оплата за запрос
  • 403 Доступ к ресурсу запрещен
  • 404 Ресурс не найден
  • 405 Метод неприменим для данного ресурса
  • 406 Недопустимый тип ресурса
  • 410 Ресурс недоступен
  • 500 Внутренняя ошибка сервера
  • 501 Метод не выполнен
  • 502 Перегрузка сервера или неисправный шлюз
  • 503 Сервер недоступен или таймаут шлюза

Методы протокола HTTP

Данная статья не преследует цель описать подробность протокола HTTP, но для понимания принципов работы примера рассмотрим несколько основных методов:

Метод GET

Метод GET является самым часто используемым и предназначен для получения информации от сервера. В качестве информации может выступать файл или результаты работы какого либо процесса, например CGI. Метод GET может дополняться условием при помощи параметра If-Modified-Since в запросе - в том случае результат передается только если ресурс имеет дату модификации, большую указанной в If-Modified-Since. Кроме запроса метод GET может применяться для передаче небольших объемов данных в виде параметров.

Метод HEAD

Метод HEAD полностью аналогичен методу GET, но в ответ сервер передает только заголовок (но не передает данные).

Метод POST

Метод POST применяется для передачи серверу данных

Метод PUT

Метод PUT предназначен для сохранения данных, переданных после заголовка запроса, под именем, указанным в запросе.

Метод DELETE

Метод DELETE используется для удаления ресурсов с указанным в запросе именем

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

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

Пример 1.

Простейший Web сервер - база для управления программой через WEB. В примере номер 1 мы рассмотрим создание простейший WEB сервер. В ответ на любой запрос он выдает одну и туже страничку с информацией о клиенте и формой, демонстрирующей передачу запросов серверу по методу GET. Данный пример может служить прототипом для систем удаленного управления/администрирования с WEB интерфейсом.

Пример 2.

Обычный Web сервер - база для разработки своих серверов. В этом примере рассмотрен полнофункциональный сервер. У него определяется директорий, в котором будут храниться файлы и он может возвращать их по запросам клиентской программы. Я ради эксперимента разместил на нем свой сайт по Delphi (с которого Вы сейчас читаете эту статью), и он прекрасно открылся при помощи IE. Единственный огрех - периодически вылетала ошибка socket error 10054, связанная с тем, что IE брал странички из кеша и рвал соединение в процессе их передачи.




Создать из Delphi документ Word, работа с текстом


Ищу поклонников Microsoft. Найду - убью.

Для создания документа Microsoft Word из Delphi нужно создать переменную, ассоциированную с Word. Если Word еще не открыт, его нужно открыть. После этого с ним можно работать примерно как в Бейсике, для изучения которого я в Word-е создаю макросы и изучаю их код.


 uses ComObj;
 
 procedure TForm1.Button1Click(Sender: TObject);
 var
   MSWord: Variant;
 begin
   try
     MsWord := GetActiveOleObject('Word.Application');
   except
     try
       MsWord := CreateOleObject('Word.Application');
       MsWord.Visible := True;
     except
       Exception.Create('Error');
     end;
   end;
   MSWord.Documents.Add;
   MSWord.Selection.Font.Size := 12;
   MSWord.Selection.TypeText('Текст');
   MSWord.Selection.Font.Bold := true;
   MSWord.Selection.TypeText(#13#10'new');
   MSWord.ActiveDocument.SaveAs('C:\ex.doc');
 end;
 

Работа с текстом

Сначала о самом простом - добавлении в документ Word нужной строки текста. Поместим на форму компоненты WordDocument, WordApplicationи WordParagraphFormat с палитры Servers. Нас интересуют в первую очередь свойство Range компонента WordDocument и свойство Selection компонента WordApplication. Классики утверждают, что они являются ссылкой на объекты Range и Selection. Range представляет из себя, проще говоря, кусок текста, это может быть как весь текст документа, так и любая его часть. Его пределы задаются двумя (или меньше) параметрами типа OleVariant.

Например:


 var  range1, range2, range3, a, b : OleVariant;
      ...
      range1:=WordDocument1.Range;
      a:=5;
      b:=15;
      range2:=WordDocument1.Range(a,b);
      range3:=WordDocument1.Range(a);
 

Первый наш объект включает в себя весь текст документа, у второго мы ограничили пределы 5-м и 15-м символами, третий представляет из себя весь последующий текст документа, начиная с 5-го символа. Объект имеет несколько полезных методов, например, с его помощью можем добавить текст в документ:


 range2.InsertAfter('MS Word');
 

Это мы вставили текст после выделенного Range. Точно также можем вставить текст и перед ним, для этого служит метод InsertBefore(). Текст, заключенный в объекте Range, можем получить так:


 WordDocument1.Range(a,b).Text;
 

Кроме того, с помощью Range можем изменить шрифт в пределах объекта. Пример:


 a:=5;
 b:=15;
 WordDocument1.Range(a,b).Font.Bold:=1;
 WordDocument1.Range(a,b).Font.Size:=14;
 WordDocument1.Range(a,b).Font.Color:=clRed;
 

Если хотим отменить выделение жирным шрифтом, присваиваем 0. Аналогично можно сделать шрифт курсивом, подчеркнутым - наберите WordDocument1.Range.Font., и среда сама подскажет, какие могут быть варианты. Методы Select, Cut, Copy и Paste работают как в обычном тексте. С помощью Paste можем на место выбранного Range вставить не только строки, но и рисунок, находящийся в буфере обмена.


 WordDocument1.Range(a,b).Select;
 WordDocument1.Range(a,b).Cut;
 WordDocument1.Range(a,b).Copy;
 WordDocument1.Range(a,b).Paste;
 

С помощью Range можем найти в документе нужную строку. Пусть в тексте содержится слово " picture" . Например, нам на его место надо будет вставить рисунок.


 var a, b, vstart, vend: OleVariant;
 j, ilengy: Integer;
 ...
 ilengy:=Length(WordDocument1.Range.Text);
 for j:=0 to ilengy-8 do begin
 a:=j;
 b:=j+7;
 if WordDocument1.Range(a,b).Text='picture' then begin
 vstart:=j;
 vend:=j+7;
 end;
 end;
 WordDocument1.Range(vstart,vend).Select;
 

Такая процедура находит и выделяет нужный кусок текста.

Теперь про Selection, представляющий из себя выделенный фрагмент документа. Если выделения нет, это текущая позиция курсора в документе. С его помощью можем вставить что-либо на место выделенного фрагмента, сделать выравнивание, изменить шрифт. Он также имеет методы InsertAfter() и InsertBefore():


 WordApplication1.Selection.InsertAfter(" text1" );
 WordApplication1.Selection.InsertBefore(" text2" );
 

Форматирование выделенного текста происходит аналогично Range, например:


 WordApplication1.Selection.Font.Bold:=1;
 WordApplication1.Selection.Font.Size:=16;
 WordApplication1.Selection.Font.Color:=clGreen;
 

Для выравнивания проще воспользоваться компонентом WordParagraphFormat. Сначала только нужно " подключить" его к выделенному фрагменту текста:


 WordParagraphFormat1.ConnectTo(WordApplication1.Selection.ParagraphFormat);
 WordParagraphFormat1.Alignment:=wdAlignParagraphCenter;
 

Значения его свойства Alignment может принимать значения wdAlignParagraphCenter, wdAlignParagraphLeft, wdAlignParagraphRight, смысл которых очевиден. Имеются и методы Cut, Copy и Paste, которые в пояснениях вряд ли нуждаются:


 WordApplication1.Selection.Cut;
 WordApplication1.Selection.Copy;
 WordApplication1.Selection.Paste;
 

Убираем выделение с помощью метода Collapse. При этом необходимо указать, в какую сторону сместится курсор, будет ли он до ранее выделенного фрагмента или после:


 var vcol: OleVariant;
 ...
 vcol:=wdCollapseStart;
 WordApplication1.Selection.Collapse(vcol);
 

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


 WordApplication1.Selection.Collapse(EmptyParam);
 

Тогда свертывание выделения производится по умолчанию, к началу выделенного текста.




Создание документов Word

Я обнаружил, что следующий код работает хорошо в связке Delphi -> Word 97 (с использованием поля "Закладки" в Word):


 ..
 implementation
 uses OleAuto;
 ..
 var
   V: Variant;
 ..
   V := 0; // не забудьте инициализировать переменную
 ..
   ..// другие функции
 
 if V = 0 then
 begin
   V := CreateOLEObject('Word.Application');
   V.WordBasic.AppShow;
 end;
 
 // данный пример показывает технологию заполнения полей
 // некой закладки в "стандартном письме" с помощью запроса,
 // выполненного прежде в модуле данных pnm_data (OK,
 // надо было бы использовать блок with...!)
 V.WordBasic.Fileopen('Имя вашего документа Word');
 V.WordBasic.EditBookmark('Заголовок', 0, 0, 0, 1);
 V.WordBasic.Insert(Title);
 V.WordBasic.EditBookmark('Имя', 0, 0, 0, 1);
 V.WordBasic.Insert(FirstName + ' ');
 V.WordBasic.EditBookmark('Фамилия', 0, 0, 0, 1);
 V.WordBasic.Insert(pnm_data.ContactsQuery1Fam_Name.AsString + ' ');
 V.WordBasic.EditBookmark('Адрес1', 0, 0, 0, 1);
 V.WordBasic.Insert(pnm_data.ContactsQuery1Address1.AsString + ' ');
 V.WordBasic.EditBookmark('Адрес2', 0, 0, 0, 1);
 V.WordBasic.Insert(pnm_data.ContactsQuery1Address2.AsString + ' ');
 V.WordBasic.EditBookmark('Адрес3', 0, 0, 0, 1);
 V.WordBasic.Insert(pnm_data.ContactsQuery1Address3.AsString + ' ');
 V.WordBasic.EditBookmark('Заголовок1', 0, 0, 0, 1);
 V.WordBasic.Insert(Title);
 V.WordBasic.EditBookmark('Фамилия1', 0, 0, 0, 1);
 V.WordBasic.Insert(pnm_data.ContactsQuery1Fam_Name.AsString + ' ');
 
 {Вы могли бы также использовать команду V.WordBasic.PrintDefault,
 если вы хотите напечатать ваш документ... и множество других команд,
 типа сохранения, смены шрифта и т.д.}
 
 //....другое
 




Создание компонента

Разработка собственных компонентов

Если вас не устраивают стандартные компоненты, поставляемые вместе с Delphi, значит, вам пора попробовать себя в создtании своих собственных. Сначала мы начнем с простых и постепенно перейдем к более сложным. И так, начнем.

Перед созданием своего компонента важно правильно выбрать для него предка. Кто же может быть предком для вашего компонента? Как правило, используются в виде предков TComponent, TControl, TWinControl, TGraphicControl, TCustomXXXXXX, а также все компоненты палитры компонентов. Возьмем для примера компонент TOpenDialog, который находится на странице Dialogs палитры компонентов. Он хорошо справляется со своей задачей, но у него есть одно маленькое неудобство. Каждый раз, когда его используешь необходимо каждый раз изменять значение свойства Options. И причем это, как правило, одни и те же действия.


 OpenDialog1.Options := OpenDialog1.Options + [ofFileMustExist, ofPathMustExist];
 

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

Задание для себя мы уже выбрали, осталось за малым - создать компонент. Заготовку для компонента создаем, выбирая из меню команду Component/New Component... и в диалоговом окне выбираем

  • Ancestor type: TOpenDialog
  • Class Name: TOurOpenDialog
  • Palette Page: Our Test

Нажали Ok и у нас появился шаблон нашего будущего компонента.

Переопределяем конструктор у этого компонента, т.е. в секции public вставляем строку:


 constructor Create(AOwner: TComponent); override;
 

нажатие на этой строке Ctrl + Shift + C создает шаблон для этого метода, внутри которого мы вставляем такие строки:


 {Вызываем унаследованный конструктор}
 inherited Create(AOwner);
 {Выполняем необходимые нам действия}
 Options := Options + [ofFileMustExist, ofPathMustExist];
 

Установка созданного компонента Component/Install Component...

  • Install Into New Package
  • Package file name: C:\Program Files\Borland\Delphi4\Lib\OurTest.dpk
  • Package description: Our tested package

Вам не нравится, что у нашего компонента иконка такая же как у стандартного? Тогда создадим для него свою собственную. Для этого нам необходимо вызвать Tools/Image Editor. Создаем новый *.dcr файл. Вставляем в него рисунок Resource/New/Bitmap. Устанавливаем размер картинки 24x24 точек. А дальше - ваше творчество... Обратите внимание: цвет точек, совпадающий с цветом точки в левом нижнем углу рисунка, будет считаться ПРОЗРАЧНЫМ!

После того как вы создали свой рисунок, переименуйте его из Bitmap1 в TOurOpenDialog и сохраните файл с именем OurOpenDialog.dcr. Удалите компонент из пакета и установите его снова (только в этом случае добавится и ссылка на *.dcr файл).

Compile, Install и удачи!




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

Автор: Steve Schafer


 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.
 




Кросс-таблица через pivot-таблицу

Автор: John Crowley

Мне нужна помощь по реализации запроса кросс-таблицы в Delphi. У кого-нибудь имеется соответствующий опыт?

Использовать pivot-таблицу должен все тот-же общий механизм (относительно к любой базе данных SQL).

Предположим, что у нас есть данные продаж в таблице с полями Store, Product, Month, Sales, и вам необходимо отображать данные по продуктам за каждый месяц. (Примем, что поле 'month' для простоты имеет значения 1..12.)

Оригинальные данные примера:

  Store         Product    Month   Sales
     #1            Toys       1      100
     #2            Toys       1       68
     #1            Toys       2      150
     #1            Books      1       75
     ...
Желаемый отчет должен выглядеть похожим на этот:
       Product         January      February    March  .....
        Toys             168          150
        Books             75         .....
Установите pivot-таблицу с именем tblPivot и 12 строками:
   pvtMonth   pvtJan  pvtFeb   pvtMar  pvtApr   ....
        1        1       0        0       0      ....
        2        0       1        0       0
        3        0       0        1       0
        4        0       0        0       1
      .....
Теперь запрос, выполненный в виде:
   select Product, January=sum(Sales*pvtJan),
                            February=sum(Sales*pvtFeb),
                           March=sum(Sales*pvtMar),
                           April=sum(Sales*pvtApr),...
   where Month = pvtMonth
   group by Product
даст вам информацию, опубликованную выше.

Поскольку pivot-таблица имеет только 12 строк, большинство SQL-движков сохранят результат в кэшовой памяти, так что скорость выполнения запроса весьма велика.




Алгоритм шифрование XOR

Призвали как-то одного волосатого админа в армию служить, на границу. Поставили его в дозор. Вдруг админ слышит шаги...
- Стой! Пароль!.. ответ из темноты:
- Владивосток...
- Логин...
- ?!..


 program Crypt;
 {$APPTYPE CONSOLE}
 
 uses Windows;
 
 var
   key, text, longkey, result : string;
   i : integer;
   toto, c : char;
   F : TextFile;
 begin
   writeln('Enter the key:');
   readln(key);
   writeln('Enter the text:');
   readln(text);
 
   for i := 0 to (length(text) div length(key)) do
     longkey := longkey + key;
 
   for i := 1 to length(text) do
   begin
     // XOR алгоритм
     toto := chr((ord(text[i]) xor ord(longkey[i])));
     result := result + toto;
   end;
   writeln('The crypted text is:');
   writeln(result);
   write('Should i save it to result.txt ?');
   read(c);
   if c in ['Y','y'] then
   begin
     AssignFile(F,'result.txt');
     Rewrite(F);
     Writeln(F,result);
     CloseFile(F);
   end;
 end.
 




Импорт CSV ASCII

Автор: Dave


 unit Cdbascii;
 
 interface
 
 uses
   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
   Forms, Dialogs, DbiErrs, DbiTypes, DbiProcs, DB, DBTables;
 
 type
   TAsciiDelimTable = class(TTable)
   private
     { Private declarations }
     fQuote: Char;
     fDelim: Char;
   protected
     { Protected declarations }
     function CreateHandle: HDBICur; override;
     procedure SetQuote(newValue: Char);
     procedure SetDelim(newValue: Char);
   public
     { Public declarations }
     constructor Create(AOwner: TComponent); override;
     destructor Destroy; override;
     { Эти свойства не должны больше публиковаться }
     property IndexFieldNames;
     property IndexName;
     property MasterFields;
     property MasterSource;
     property UpdateMode;
   published
     { Published declarations }
     property Quote: Char read fQuote write setQuote default '"';
     property Delim: Char read fDelim write setDelim default ',';
   end;
 
 procedure Register;
 
 implementation
 
 uses DBConsts;
 
 procedure Register;
 begin
   RegisterComponents('Data Access', [TAsciiDelimTable]);
 end;
 
 constructor TAsciiDelimTable.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   Exclusive := True;
   TableType := ttASCII;
   fQuote := '"';
   fDelim := ',';
 end;
 
 destructor TAsciiDelimTable.Destroy;
 begin
   inherited Destroy;
 end;
 
 { Рабочий код }
 
 function CheckOpen(Status: DBIResult): Boolean;
 begin
   case Status of
     DBIERR_NONE:
       Result := True;
     DBIERR_NOTSUFFTABLERIGHTS:
       begin
         if not Session.GetPassword then
           DbiError(Status);
         Result := False;
       end;
   else
     DbiError(Status);
   end;
 end;
 
 function TAsciiDelimTable.CreateHandle: HDBICur;
 const
   OpenModes: array[Boolean] of DbiOpenMode = (dbiReadWrite, dbiReadOnly);
   ShareModes: array[Boolean] of DbiShareMode = (dbiOpenShared, dbiOpenExcl);
 var
   STableName: array[0..SizeOf(TFileName) - 1] of Char;
   SDriverType: array[0..12] of Char;
 begin
   if TableName = '' then
     DBError(SNoTableName);
   AnsiToNative(DBLocale, TableName, STableName, SizeOf(STableName) - 1);
   StrPCopy(SDriverType, 'ASCIIDRV-' + Quote + '-' + Delim);
   Result := nil;
   while not CheckOpen(DbiOpenTable(DBHandle, STableName, SDriverType,
     nil, nil, 0, OpenModes[ReadOnly], ShareModes[Exclusive],
     xltField, False, nil, Result)) do {Повтор}
     ;
 end;
 
 procedure TAsciiDelimTable.SetQuote(newValue: Char);
 begin
   if Active then
     { DBError(SInvalidBatchMove); };
     fQuote := newValue;
 end;
 
 procedure TAsciiDelimTable.SetDelim(newValue: Char);
 begin
   if Active then
     { DBError(SInvalidBatchMove); };
     fDelim := newValue;
 end;
 
 end.
 




Быстрая обработка CSV файла

Hа боpту самолета:
- Здpавствуйте, дамы и господа, - говоpит командиp экипажа. - Мы благодаpим вас за то, что вы выбpали нашу авиакомпанию для пеpвого полета в пеpвый день нового 2000 года. Мы находимся на высоте 3 тыс. футов, наша скоpость... вау!... ох, блин!... вот фак!... Извините за неудобства, котоpые вы испытываете, находясь вниз головой, надеюсь, все были пpистегнуты. Есть ли сpеди пассажиpов на боpту пpогpаммист?

Классы Tstrings/TStringlist имеют свойство commatext, которое автоматически разделяет строки, содержащие разделители, на отдельные части. Пример показывает как считать CSV файл. В Конечном итоге, автоматически разделённые строки содержатся в TStringlist.


 var
   ts: tstringlist;
   S: string;
   Tf: Textfile;
 begin
   Ts := Tstringlist.create;
   Assignfile(tf, 'filename');
   Reset(tf);
   while not eof(tf) do
   begin
     Readln(tf,S);
     Ts.CommaText := S;
     //ProcessLine;
   end;
   closefile(tf);
   ts.free;
 end;
 

Так же операцию можно производить в обратном порядке.

Свойство Commatext поддерживает разделители как в виде запятых, так и двойных кавычек: 1,2,3,4 и "1","2","3","4"

Например, строка вида "1","2,3","4" будет разделена на три элемента, которые заключены в кавычки (средняя запятая будет проигнорирована). Чтобы включить кавычку в конечный результ, нужно поставить две кавычки подряд: "1",""2" (результат будет 1 и "2 ).




Денежное поле редактирования

Приходит программист в библиотеку и говорит:
- Позовите мне архивариуса! Мне надо его спросить!
- Я его отправил в архив. Могу я вам помочь?
- Разархивируйте его, он мне срочно нужен!


 unit CurrEdit;
 
 interface
 
 uses
   SysUtils,
   WinTypes,
   WinProcs,
   Messages,
   Classes,
   Graphics,
   Controls,
   Menus,
   Forms,
   Dialogs,
   StdCtrls;
 
 type
   TCurrencyEdit = class(TCustomMemo)
   private
     DispFormat: string;
     FieldValue: Extended;
     procedure SetFormat(A: string);
     procedure SetFieldValue(A: Extended);
     procedure CMEnter(var Message: TCMEnter); message CM_ENTER;
     procedure CMExit(var Message: TCMExit); message CM_EXIT;
     procedure FormatText;
     procedure UnFormatText;
   protected
     procedure KeyPress(var Key: Char); override;
     procedure CreateParams(var Params: TCreateParams); override;
   public
     constructor Create(AOwner: TComponent); override;
   published
     property Alignment default taRightJustify;
     property AutoSize default True;
     property BorderStyle;
     property Color;
     property Ctl3D;
     property DisplayFormat: string read DispFormat write SetFormat;
     property DragCursor;
     property DragMode;
     property Enabled;
     property Font;
     property HideSelection;
     property MaxLength;
     property ParentColor;
     property ParentCtl3D;
     property ParentFont;
     property ParentShowHint;
     property PopupMenu;
     property ReadOnly;
     property ShowHint;
     property TabOrder;
     property Value: Extended read FieldValue write SetFieldValue;
     property Visible;
     property OnChange;
     property OnClick;
     property OnDblClick;
     property OnDragDrop;
     property OnDragOver;
     property OnEndDrag;
     property OnEnter;
     property OnExit;
     property OnKeyDown;
     property OnKeyPress;
     property OnKeyUp;
     property OnMouseDown;
     property OnMouseMove;
     property OnMouseUp;
   end;
 
 procedure Register;
 
 implementation
 
 procedure Register;
 begin
   RegisterComponents('Additional', [TCurrencyEdit]);
 end;
 
 constructor TCurrencyEdit.Create(AOwner: TComponent);
 begin
   inherited Create(AOwner);
   AutoSize := True;
   Alignment := taRightJustify;
   Width := 121;
   Height := 25;
   DispFormat := '$,0.00;($,0.00)';
   FieldValue := 0.0;
   AutoSelect := False;
   WantReturns := False;
   WordWrap := False;
   FormatText;
 end;
 
 procedure TCurrencyEdit.SetFormat(A: string);
 begin
   if DispFormat <> A then
   begin
     DispFormat := A;
     FormatText;
   end;
 end;
 
 procedure TCurrencyEdit.SetFieldValue(A: Extended);
 begin
   if FieldValue <> A then
   begin
     FieldValue := A;
     FormatText;
   end;
 end;
 
 procedure TCurrencyEdit.UnFormatText;
 var
   TmpText: string;
   Tmp: Byte;
   IsNeg: Boolean;
 begin
   IsNeg := (Pos('-', Text) > 0) or (Pos('(', Text) > 0);
   TmpText := '';
   for Tmp := 1 to Length(Text) do
     if Text[Tmp] in ['0'..'9', '.'] then
       TmpText := TmpText + Text[Tmp];
   try
     FieldValue := StrToFloat(TmpText);
     if IsNeg then
       FieldValue := -FieldValue;
   except
     MessageBeep(mb_IconAsterisk);
   end;
 end;
 
 procedure TCurrencyEdit.FormatText;
 begin
   Text := FormatFloat(DispFormat, FieldValue);
 end;
 
 procedure TCurrencyEdit.CMEnter(var Message: TCMEnter);
 begin
   SelectAll;
   inherited;
 end;
 
 procedure TCurrencyEdit.CMExit(var Message: TCMExit);
 begin
   UnformatText;
   FormatText;
   inherited;
 end;
 
 procedure TCurrencyEdit.KeyPress(var Key: Char);
 begin
   if not (Key in ['0'..'9', '.', '-']) then
     Key := #0;
   inherited KeyPress(Key);
 end;
 
 procedure TCurrencyEdit.CreateParams(var Params: TCreateParams);
 begin
   inherited CreateParams(Params);
   case Alignment of
     taLeftJustify: Params.Style := Params.Style or ES_LEFT and not ES_MULTILINE;
     taRightJustify: Params.Style := Params.Style or ES_RIGHT and not
       ES_MULTILINE;
     taCenter: Params.Style := Params.Style or ES_CENTER and not ES_MULTILINE;
   end;
 end;
 
 end.
 




Как узнать имя файла текущего процесса

Для этого существует функция GetModuleFileName, которая возвращает имя файла текущего процесса.


 function GetModName: string;
 var
   fName: string;
   nsize: cardinal;
 begin
   nsize := 128;
   SetLength(fName, nsize);
   SetLength(fName,
     GetModuleFileName(
     hinstance,
     pchar(fName),
     nsize));
   Result := fName;
 end;
 




Текущий модуль и проект

Автор: Dr. Bob

Компонент во время проектирования может знать имена текущих модулей и имя проекта. Все это можно получить с помощью ToolServices (см. файл TOOLINTF.PAS)

Имя текущего проекта можно получить с помощью вызова GetProjectName, список модулей/форм - с помощью функции GetUnitCount, которая возвратит количество модулей и затем с помощью GetUnitName(i) мы можем получить имя каждого модуля (также и с формами).

Вот примерный образец кода (получение и запись имен всех модулей/форм в StringGrid и имени проекта в Label):


 procedure TInformationFrm.FormActivate(Sender: TObject);
 { необходимо: StringGrid1 (2 колонки, масса строк), Label1, Label2 }
 var
   i, j: Integer;
   Tmp: string;
 begin
   StringGrid1.Cells[0, 0] := 'модулей:';
   StringGrid1.Cells[1, 0] := 'форм:';
   if ToolServices <> nil then
     with ToolServices do
     begin
       Label1.Caption := ExtractFileName(GetProjectName); { простое имя }
       Label2.Caption := GetProjectName;   { полное правильное имя пути }
       for i := 0 to GetUnitCount do
       begin
         Tmp := ExtractFileName(GetUnitName(i));
         StringGrid1.Cells[0, i + 1] := Tmp;
         Tmp := ChangeFileExt(Tmp, '.DFM');
         for j := 0 to GetFormCount do
           if ExtractFileName(GetFormName(j)) = Tmp then
             StringGrid1.Cells[1, i + 1] := Tmp
       end;
     end;
 end;
 




Как поместить курсор мышки в нужное место на форме


 uses
   Windows;
 
 procedure PlaceMyMouse(Sender: TForm; X, Y: word);
 var
   MyPoint: TPoint;
 begin
   MyPoint := Sender.ClientToScreen(Point(X, Y));
   SetCursorPos(MyPoint.X, MyPoint.Y);
 end;
 




Как можно узнать количество цветов текущего режима

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

GetDeviceCaps(Form1.Canvas.Handle, BITSPIXEL) *
 GetDeviceCaps(Form1.Canvas.Handle, PLANES)
Для получения общего количества битов, используемых для получения цвета используются следующие значения.
1 = 2 colors bpp
 4 = 16 colors bpp
 8 = 256 colors bpp
 15 = 32768 colors (возвращает 16 на большинстве драйверов) bpp
 16 = 65535 colors bpp
 24 = 16,777,216 colors bpp
 32 = 16,777,216 colors (то же, что и 24) bpp
Вы можете использовать:
NumberOfColors := (1 shl
 (GetDeviceCaps(Form1.Canvas.Handle, BITSPIXEL) *
 GetDeviceCaps(Form1.Canvas.Handle, PLANES));

для подсчета общего количества используемых цветов.




Как сделать так, чтобы работали команды Cut, Copy в WebBrowsere

Будущий сайт компании Yahoo! в домене Европейского Союза: www.yahoo.eu

Вам нужно добавить следующие строки в начало unit:


 initialization
   OleInitialize(nil);
 
 finalization
   OleUninitialize;
 

Это не ошибка. Информацию по данному вопросу можно найти на сайте Microsoft KnowledgeBase статья Q168777. Приведённый ниже код, устраняет данную проблему:


 ...
 
 var
   Form1: TForm1;
   FOleInPlaceActiveObject: IOleInPlaceActiveObject;
   SaveMessageHandler: TMessageEvent;
 
 ...
 
 implementation
 
 ...
 
 procedure TForm1.FormActivate(Sender: TObject);
 begin
   SaveMessageHandler := Application.OnMessage;
   Application.OnMessage := MyMessageHandler;
 end;
 
 procedure TForm1.FormDeactivate(Sender: TObject);
 begin
   Application.OnMessage := SaveMessageHandler;
 end;
 
 procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   Application.OnMessage := SaveMessageHandler;
   FOleInPlaceActiveObject := nil;
 end;
 
 procedure TForm1.MyMessageHandler(var Msg: TMsg; var Handled: Boolean);
 var
   iOIPAO: IOleInPlaceActiveObject;
   Dispatch: IDispatch;
 begin
   { exit if we don't get back a webbrowser object }
   if WebBrowser = nil then
   begin
     Handled := False;
     Exit;
   end;
 
   Handled:=(IsDialogMessage(WebBrowser.Handle, Msg) = True);
 
   if (Handled) and (not WebBrowser.Busy) then
   begin
     if FOleInPlaceActiveObject = nil then
     begin
       Dispatch := WebBrowser.Application;
       if Dispatch <> nil then
       begin
         Dispatch.QueryInterface(IOleInPlaceActiveObject, iOIPAO);
         if iOIPAO <> nil then
           FOleInPlaceActiveObject := iOIPAO;
       end;
     end;
 
     if FOleInPlaceActiveObject <> nil then
       if ((Msg.message = WM_KEYDOWN) or (Msg.message = WM_KEYUP)) and
          ((Msg.wParam = VK_BACK) or (Msg.wParam = VK_LEFT) or (Msg.wParam = VK_RIGHT)) then
         //nothing - do not pass on Backspace, Left or Right arrows
       else
         FOleInPlaceActiveObject.TranslateAccelerator(Msg);
   end;
 end;
 




Кириллица в параметрах CGI-запроса

WWW - уникальное явление из мира насекомых. Пауки, чтобы завлечь муху в сеть, рисуют красивые картинки и пишут тексты на HTML.

Вопрос: Я хочу реализовать регистрацию своей программы через Internet. Для этого я вызываю CGI-скрипт, которому в качестве параметра передается имя пользователя. Однако, если имя набрано кириллицей, происходит ошибка. В чем дело?

Дело в том, что при передаче запроса по протоколу HTTP служебные символы и символы с кодами 128..255 надо кодировать. То есть, если пользователь ввел имя 'Вася Пупкин', то запрос для регистрации должен выглядеть не так:

      http://site/cgi-bin/reg.pl?user=Вася Пупкин
 

а вот так:

      http://site/cgi-bin/reg.pl?user=%C2%E0%F1%FF+%CF%F3%EF%EA%E8%ED
 

Решить проблему перекодировки туда и обратно может компонент TNMURL.

DK: Дополнительную информацию про кодирование URL'ов, можно прочитать в RFC1738




Delphi и COM объекты - решение проблем.

Автор: Mike Scott

...я обращался к справке MS Help, но и там я не нашел как работать с объектами COM в Delphi.

Работать с COM-объектами в Delphi очень просто, поскольку объекты Delphi имеют ту же структуру, что и объекты COM. Единственное различие заключается в том, что в определении COM имеется три метода для изменения состояния COM объекта: QueryInterface, AddRef и Release.

Теперь для того, чтобы иметь доступ к COM объекту из другого приложения или DLL, вам необходимо написать в Delphi объявление виртуального абстрактного класса, являющегося потомком IUnknown (в котором объявлены QueryInterface, AddRef и Release). В этом классе для COM объекта вы добавляете методы, объявленные в заголовочном файле C, в том же порядке следования. В этом случае вы запрашиваете интерфейс IShellLink, определенный в SHLOBJ.C и один из интерфейсов, предоставляемых Delphi 2, с помощью которого вы сможете реализовать свой собственный. Это может выглядеть приблизительно так:


 type
 IShellLink = class( IUnknown )
 function GetPath( pszFile    : PChar ;
 cchMaxPath : integer ;
 pfd        : PWIN32_FIND_DATA ;
 fFlags     : cardinal ) : HResult ; virtual ; stdcall ;
 abstract ;
 
   // ... и т.д..
 end ;
 

Вы объявляете переменную для объекта IShellLink и вызываете метод GetPath?

Вы можете создавать экземпляр IShellLink, используя CoCreateInstance и передавая CLSID для IShellLink. Затем вы можете вызывать методы IShellLink, как, например, GetPath. Описание механизма работы может занять не одну статью, но реализованная в Delphi высокоуровневая инкапсуляция делает жизнь программиста намного легче, без необходимости залезать в столь глубокие дебри данной технологии. Особо любознательным я предлагаю преобрести "Programmer's Guide to Microsoft Windows 95", содержащую примеры (к сожалению, на C), лежащие в плоскости нашей темы.




Изменение системного времени в Delphi

Программист:
- Сегодня у сына день рождения.
- И сколько ему исполняется?
- 1024 дня.

Можно. Попробуйте следующий код:


 Procedure settime(hour, min, sec, hundreths : byte); assembler;
 asm
   mov  ch, hour
   mov  cl, min
   mov  dh, sec
   mov  dl, hundreths
   mov  ah, $2d
   int  $21
 end;
 
 Procedure setdate(Year : word; Month, Day : byte); assembler;
 asm
   mov  cx, year
   mov  dh, month
   mov  dl, day
   mov  ah, $2b
   int  $21
 end;
 




Ошибка RichEdit в Delphi

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

Я написал программу, передающую невидимому RichEdit введенную пользователем с помощью кнопок и нескольких checkbox (кнопки с независимой фиксацией) информацию. Программа разрабатывалась и эксплуатировалась под Windows 95 и работала без проблем. Но под NT 4.0 строка ...

RichEdit1.Print('');

возвращала ошибку "Divide by Zero" (деление на ноль). Единственный выход из создавшегося положения заключался в сохранении файла c последующей его загрузкой и печатью с помощью MS Word.

Кому-нибудь приходилось решать эту проблему?

Да, я знаю что нужно сделать...

Чтобы решить эту проблему, необходимо небольшое хирургическое вмешательство в VCL модуль ComCtrls.pas.

Я протестировал исправленный код на большинстве платформ, в том числе на NT 4.0 и Win95, и, кажется, все работает как положено. На самом деле это легко исправить, только нужно знать где...


 {
 Существует проблема совместимости при вызове оригинального метода RichEdit.Print
 под NT 4.0. Исключительная ситуация EDivByZero происходит из-за того,
 что свойство Printer.Handle вне блока BeginDoc/EndDoc под NT 4.0
 возвращает дескриптор информационного контекста (Information Context - IC) вместо
 дескриптора контекста устройства (Device Context - DC). EM_FORMATRANGE пытается
 использовать этот IC вместо реального DC принтера, вызывая этим исключительную
 ситуацию. Если свойство Handle акцептуется ПОСЛЕ BeginDoc, дескриптор контекста
 устройства возвращает истину, что и было мною исправлено в коде. Я оставил на
 том же месте в коде оригинальное месторасположение вызова BeginDoc, при этом
 сделав соответствующий комментарий для указания на внесенные изменения.
 }
 
 procedure TCustomRichEdit.Print(const Caption: string);
 var
 
   Range: TFormatRange;
   LastChar, MaxLen, LogX, LogY: Integer;
 begin
 
   FillChar(Range, SizeOf(TFormatRange), 0);
   with Printer, Range do
   begin
     LogX := GetDeviceCaps(Handle, LOGPIXELSX);
     LogY := GetDeviceCaps(Handle, LOGPIXELSY);
     // Спозиционированный вызов BeginDoc для обеспечения
     // совместимости под NT 4.0 и Win95
     BeginDoc;
     hdc := Handle;
     hdcTarget := hdc;
     if IsRectEmpty(PageRect) then
     begin
       rc.right := PageWidth * 1440 div LogX;
       rc.bottom := PageHeight * 1440 div LogY;
     end
     else
     begin
       rc.left := PageRect.Left * 1440 div LogX;
       rc.top := PageRect.Top * 1440 div LogY;
       rc.right := PageRect.Right * 1440 div LogX;
       rc.bottom := PageRect.Bottom * 1440 div LogY;
     end;
     rcPage := rc;
     Title := Caption;
     // Оригинальная позиция BeginDoc
     { BeginDoc; }
     LastChar := 0;
     MaxLen := GetTextLen;
     chrg.cpMax := -1;
     repeat
       chrg.cpMin := LastChar;
       LastChar := SendMessage(Self.Handle, EM_FORMATRANGE, 1, Longint(@Range));
       if (LastChar < MaxLen) and (LastChar <> -1) then
         NewPage;
     until (LastChar >= MaxLen) or (LastChar = -1);
     EndDoc;
   end;
   SendMessage(Handle, EM_FORMATRANGE, 0, 0);
 end;
 




Как создать таблицу в MS Access при помощи DAO

1. Объявляем переменные:


 var
   access, db, td, recordset: Variant;
 

2. объявляем массив констант соответствия типов данных (между полями в Delphi и типами полей DAO)


   arrMDBTypes: array[TFieldType] of Integer =
     ({dbText} 10 {ftUnknown},
      {dbText} 10 {ftString},
      {dbInteger} 3 {ftSmallint},
      {dbLong} 4 {ftInteger},
      {dbInteger} 3 {ftWord},
      {dbBoolean} 1 {ftBoolean},
      {dbDouble} 7 {ftFloat},
      {dbCurrency} 5 {ftCurrency},
      {dbDouble} 7 {ftBCD},
      {dbDate} 8 {ftDate},
      {dbTime} 22 {ftTime},
      {dbDate} 8 {ftDateTime},
      {dbLongBinary} 11 {ftBytes},
      {dbLongBinary} 11 {ftVarBytes},
      {dbInteger} 3 {ftAutoInc},
      {dbLongBinary} 11 {ftBlob},
      {dbMemo} 12 {ftMemo},
      {dbLongBinary} 11 {ftGraphic},
      {dbMemo} 12 {ftFmtMemo},
      {dbLongBinary} 11 {ftParadoxOle},
      {dbLongBinary} 11 {ftDBaseOle},
      {dbBinary} 9 {ftTypedBinary},
      {dbText} 10 {ftCursor}
 
     {$IFDEF VER120}
      ,
      {dbText} 10 {ftFixedChar},
      {dbText} 10 {ftWideString},
      {dbBigInt} 16 {ftLargeint},
      {dbText} 10 {ftADT},
      {dbText} 10 {ftArray},
      {dbText} 10 {ftReference},
      {dbText} 10 {ftDataSet}
     {$ELSE}
 
     {$IFDEF VER125}
      ,
      {dbText} 10 {ftFixedChar},
      {dbText} 10 {ftWideString},
      {dbBigInt} 16 {ftLargeint},
      {dbText} 10 {ftADT},
      {dbText} 10 {ftArray},
      {dbText} 10 {ftReference},
      {dbText} 10 {ftDataSet}
 
     {$ELSE}
 
     {$     ,
      {dbText} 10 {ftFixedChar},
      {dbText} 10 {ftWideString},
      {dbBigInt} 16 {ftLargeint},
      {dbText} 10 {ftADT},
      {dbText} 10 {ftArray},
      {dbText} 10 {ftReference},
      {dbText} 10 {ftDataSet},
      {dbLongBinary} 11 {ftOraBlob},
      {dbLongBinary} 11 {ftOraClob},
      {dbText} 10 {ftVariant},
      {dbText} 10 {ftInterface},
      {dbText} 10 {ftIDispatch},
      {dbGUID} 15 {ftGuid}
     {$ENDIF}
     {$ENDIF}
     {$ENDIF}
 
     );
 


 // 3. загружаем DAO:
     try
       access := GetActiveOleObject('DAO.DBEngine.35');
     except
       access := CreateOleObject('DAO.DBEngine.35');
     end;
 
 // 4. открываем базу данных
     try
       db := access.OpenDatabase(yourDatabaseName);
     except
       exit
     end;
 
 // 5. созда¸м новую таблицу в открытой базе данных
     td := db.CreateTableDef(yourTableName, 0, '', '');
 
 // 6. добавляем в таблицу поле с описаниями
     td.Fields.Append(td.CreateField(strFieldName,
      arrMDBTypes[intDataType], Size));
 
 // например,
     td.Fields.Append(td.CreateField('ID', arrMDBTypes[intDataType], Size));
     td.Fields.Append(td.CreateField('NAME', arrMDBTypes[intDataType], Size));
 
 // 7. добавляем таблицу в список таблиц
     db.TableDefs.Append(td);
 
 // 8. открываем созданную таблицу
     recordset := db.OpenTable(yourTableName, 0);
 
 // 9. добавляем новую запись в открытую таблицу
     recordset.AddNew;
 
 // 10. изменяем значения поля
      curField := recordset.Fields[0].Value := 1;
      curField := recordset.Fields[1].Value := 'First record';
 
 // 11. помещаем новую запись в базу
      recordset.Update(dbUpdateRegular, False);
 // где
 const
   dbUpdateRegular = 1;
 
 // 12. закрываем recordset
      recordset.Close;
 
 // 13. закрываем базу данных
      db.Close;
 
 // 14. освобождаем экземпляр DAO
      access := UnAssigned;
 




Database Desktop показывает содержимое таблиц шрифтом без русских букв


Вопрос в кроссворде:
- Язык програмирования из трех букв.
Ответ:
- c++

Для DBD 5.0 в файл c:\windows\pdoxwin.ini вставить в секцию:


 [Properties]
 SystemFont=Arial Cyr
 

Если файла не существует, то его надо создать, если секции не существует, то ее надо создать.

Для DBD 7.0 нужно испpавить pеестp - ключ:


 HKCU\Software\Borland\DBD\7.0\ Preferences\Properties\SystemFont="Fixedsys"
 




Модуль данных для каждого MDIChild

Автор: Pat Ritchey

Встречаются два программиста.
- Хочешь, новый анекдот про Билла Гейтса расскажу?
- Давай!
- Приходит утром слуга к БГ, а тот умер!
- А дальше?
- Ну, дальше я не запомнил... Ho какое начало!

Когда во время разработки вы устанавливаете "DataSource"-свойство в БД-компонентах для указания на модуль данных, VCL во время выполнения приложения будет пытаться создать связь с существующим TDataModule, основываясь на его свойтсве Name. Так, если вы добавите модуль данных к вашему проекту и переместите его в свойстве проекта из колонки автоматически создаваемых форм в колонку доступных, вы сможете разработать форму, содержащую элементы управления для работы с базами данных, после чего несколькими строчками кода можете создать экземпляр формы, имеющий экземпляр собственного модуля данных.

С помощью Репозитория создайте "standard MDI application" (стандартное MDI-приложение), в котором модуль TMDICHild будет похож на приведенный ниже. Добавленные строки имеют комментарий {!}. Хитрости спрятаны в конструкторе create и задании другого порядка следования операторов.


 unit Childwin;
 
 interface
 
 uses Windows, Classes, Graphics, Forms, Controls,
   ExtCtrls, DBCtrls, StdCtrls, Mask, Grids, DBGrids,
   DataM; {!} // Модуль TDataModule1
 
 type
   TMDIChild = class(TForm)
     DBGrid1: TDBGrid;
     DBGrid2: TDBGrid;
     DBEdit1: TDBEdit;
     DBEdit2: TDBEdit;
     DBNavigator1: TDBNavigator;
     procedure FormClose(Sender: TObject; var Action: TCloseAction);
   private
     { Private declarations }
   public
     { Public declarations }
     {!} DM: TDataModule1;
     {!} constructor Create(AOwner: TComponent); override;
   end;
 
 implementation
 
 {$IFDEF XOXOXOX} // DataM должен находиться в секции interface. Необходимо для среды
 
 uses DataM; // времени проектирования. Определение "XOXOXOX" подразумевает,
 {$ENDIF} // что это никогда не будет определено, но чтобы компилятор видел это.
 
 {$R *.DFM}
 
 {!} constructor TMDIChild.Create;
 {!}
 begin
   {!} DM := TDataModule1.Create(Application);
   {!} inherited Create(AOwner);
   {!} DM.Name := '';
   {!}
 end;
 
 procedure TMDIChild.FormClose(Sender: TObject; var Action: TCloseAction);
 begin
   Action := caFree;
 end;
 
 end.
 




Отследить изменение данных

Автор: Nomadic

Предположим, что пользователь изменил строковое поле в Null. Как тогда я в обработчике OnUpdateData смогу определить, изменилось ли это поле на строку Null, или поле просто не было изменено?

Используйте свойство NewValue класса TField при чтении второй записи (той, которая содержит изменения). Если возвращаемое значение (variant) пусто или не назначено, тогда поле не было модифицировано. Здесь немного иллюстрирующего кода:


 var
   NewVal: Variant;
 begin
   NewVal := DataSet.FieldByName('MyStrField').NewValue;
   if VarIsEmpty(NewVal) then
     ShowMessage('Field was not edited')
   else if VarIsNull(NewVal) then
     ShowMessage('Field was blanked out')
   else
     ShowMessage('New Field Value: ' + String(NewVal));
 end;
 

Если Вы взглянете на исходники формы RecError (в репозитории), то Вы увидите, как она использует эту информацию для вывода строки '' при показе ошибок синхронизации данных. На сервере Вы добавляете ограничения уровня записи, используя свойство Constraints Вашего TQuery/TTable или ограничения уровня поля, используя постоянные обьекты TField (с помощью FieldsEditor либо на CustomConstraint, либо ImportedConstraint). Если Вы используете ограничения уровня поля, они вступают в силу, когда данныеотправляются в поле (например, когда Вы уходите из органа управления, связанного с этим полем (типа TDBEdit)).




Изменение данных в Delphi 7 (BDE)

Автор: Rob Edgar

...из исходного кода VCL я обнаружил, что при назначении значения DB-полю, имеющему строковый тип, значение "проходит" через функцию ANSItoNative, что может привести к изменению (порче) ASCII-данных. Вот так...

Как 16-, так и 32-битные версии IDAPI.CFG устанавливаются с драйвером языка Paradox 'ascii'.

Я создал простое приложение, записывающее в db-поле значения ASCII в диапазоне 0-255 и затем проверяющее их на предмет появившихся различий..... различия между 16- и 32-битной версией не так велики... для примера... в первых 130 значениях получается следующее преобразование:

  16-бит: 21->182 22->167 31->33 130->128
  32-бит:                        130->128
Очевидно достаточно просто "исправить" 32-битные приложения, чтобы добиться такого же результата, что и получаемые 16-битными приложениями, НО я не уверен что решив проблему на моем PC, я решу ее у остальных пользователей, поскольку могут отличаться установки, драйверы языка... и пр.

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

 Значение ASCII    Delphi1     Delphi2
        21            182         21
        22            167         22
        33             31         33
       132            102        132
       255            121        255



Хранение данных в EXE-файле

Автор: Peter Below

Вы можете включить любой тип данных как RCDATA или пользовательских тип ресурса. Это очень просто. Данный совет покажет вам общую технику создания такого ресурса.


 Type
   TStrItem = String[39];  { 39 символов + байт длины -> 40 байтов }
   TDataArray = Array [0..7, 0..24] of TStrItem;
 
 Const
   Data: TDataArray = (
   ('..', ...., '..' ),  { 25 строк на строку }
   ...                   { 8 таких строк }
   ('..', ...., '..' )); { 25 строк на строку }
 

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


 program MakeData;
 type
   TStrItem = string[39]; { 39 символов + байт длины -> 40 байтов }
   TDataArray = array[0..7, 0..24] of TStrItem;
 
 const
   Data: TDataArray = (
     ('..', ...., '..'), { 25 строк на строку }
     ... { 8 таких строк }
     ('..', ...., '..')); { 25 строк на строку }
 
 var
   F: file of TDataArray;
 begin
   Assign(F, 'data.dat');
   Rewrite(F);
   Write(F, Data);
   Close(F);
 end.
 

Теперь подготовьте файл ресурса и назовите его DATA.RC. Он должен содержать только следующую строчку:

 DATAARRAY RCDATA "data.dat"
Сохраните это, откройте сессию DOS, перейдите в каталог где вы сохранили data.rc (там же, где и data.dat!) и выполните следующую команду:
 brcc data.rc   (brcc32 для Delphi 2.0)

Теперь вы имеете файл data.res, который можете подключить к своему Delphi-проекту. Во время выполнения приложения вы можете генерировать указатель на данные этого ресурса и иметь к ним доступ, что и требовалось.


 { в секции interface модуля  }
 type
   TStrItem = string[39]; { 39 символов + байт длины -> 40 байтов }
   TDataArray = array[0..7, 0..24] of TStrItem;
   PDataArray = ^TDataArray;
 const
   pData: PDataArray = nil; { в Delphi 2.0 используем Var }
 
 implementation
 {$R DATA.RES}
 
 procedure LoadDataResource;
 var
   dHandle: THandle;
 begin
   { pData := Nil; если pData - Var }
   dHandle := FindResource(hInstance, 'DATAARRAY', RT_RCDATA);
   if dHandle <> 0 then
   begin
     dhandle := LoadResource(hInstance, dHandle);
     if dHandle <> 0 then
       pData := LockResource(dHandle);
   end;
   if pData = nil then
     { неудача, получаем сообщение об ошибке с помощью
     WinProcs.MessageBox, без помощи VCL, поскольку здесь код
     выполняется как часть инициализации программы и VCL
     возможно еще не инициализирован! }
 end;
 
 initialization
   LoadDataResource;
 end.
 

Теперь вы можете ссылаться на элементы массива с помощью синтаксиса pData^[i,j].




Передача в Word данных и формирование таблицы

Время теряется на переключение проццесов. Чем больше таблица тем хуже. Каждая клетка таблицы это переключение. Сформируйте стороку данных передайте Word (один процесс) затем конвертируйте текст в таблицу (второй процесс) Ниже приведе текст рабочей процедуры, написанны на Delphi 6.0 для компонентов Офиса 97. Успешно работает и с 2000


 procedure Spisok_Sotrudnikov2(Name: String);
 var
 {Объявление переменных, для передачи их в качестве формальных параметров в}
 { сервер автоматизации}
   Shablon,FileName,Tempo,Separator,NumColumns:OleVariant;
   i,k : Integer;
   MyRange : Range;   {Область документа}
   Tabl : Table;      {Одна таблица}
   Pars : Paragraphs; {Массив параграфов}
   Par  : Paragraph;  {Один параграф}
   S : Array[1..9] of String;
   Text : WideString;
   Text1: String;
 begin
   Screen.Cursor:=crHourGlass;
 {Оформление бегущей линейки}
   Otchet_Spisok_Sotrudnikov.BitBtn1.Visible:=False;
   Otchet_Spisok_Sotrudnikov.Gauge1.Visible:=True;
 {Определяем файл шаблона документа и файл для сохранения результата}
   Shablon:=ExtractFilePath(Application.EXEName)+'Spisok.Doc';
   FileName:=ExtractFilePath(Application.EXEName)+'Spisok_Sotrudnikov1.DOC';
 {Открываем шаблон документа}
 Otchet_Spisok_Sotrudnikov.WordApplication1.Documents.Open(Shablon,EmptyParam
 ,EmptyParam,EmptyParam,
 EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                                   EmptyParam,EmptyParam);
 {Связываем компоненту с существующим интерфейсом}
 Otchet_Spisok_Sotrudnikov.WordDocument1.ConnectKind:=ckAttachToInterface;
 Otchet_Spisok_Sotrudnikov.WordDocument1.ConnectTo(Otchet_Spisok_Sotrudnikov.
 WordApplication1.ActiveDocument);
 {Обязательно отключить проверки орфографии и граматики в Word}
 Otchet_Spisok_Sotrudnikov.WordApplication1.Options.CheckSpellingAsYouType:=f
 alse;
 Otchet_Spisok_Sotrudnikov.WordApplication1.Options.CheckGrammarAsYouType:=fa
 lse;
 {Опредеоляем область документа}
 MyRange:=Otchet_Spisok_Sotrudnikov.WordDocument1.Range(EmptyParam,EmptyParam
 );
     Tempo:=MyRange;
 {Оформляем заголовок}
     Pars:=Otchet_Spisok_Sotrudnikov.WordDocument1.Paragraphs;
     Par:=Pars.Add(Tempo);
     Par.Alignment:=wdAlignParagraphCenter;  {Выравнивание параграфа}
     Par.Range.Font.Bold:=1;          {Шрифт жирный}
     Par.Range.Font.Size:=14;         {Размер шрифта}
     Par.Range.Font.ColorIndex:=1;    {Цвет шрифта зеленый}
     Par.Range.InsertBefore(Name);
     Tempo:=Par.Range.Get_End_; {Определяем конец области}
     MyRange:=Otchet_Spisok_Sotrudnikov.WordDocument1.Range(Tempo);
 {Формирование данных}
        DataModule1.IBQuery2.Open;
        DataModule1.IBQuery2.FetchAll;
        i:=DataModule1.IBQuery2.RecordCount;
        Otchet_Spisok_Sotrudnikov.Gauge1.MaxValue:=i;
        Text:='? п/п@Фамилия, Имя, Отчество@Должность@Табельный номер@';
        for k:=1 to i do begin
          Text1:='';
          Text1:=Text1+IntToStr(k)+'@';
          Text:=Text+Text1;
             if not DataModule1.IBQuery2.FieldByName('FML').IsNull then
                S[1]:=DataModule1.IBQuery2.FieldByName('FML').Value;
             if not DataModule1.IBQuery2.FieldByName('IME').IsNull then
                S[2]:=DataModule1.IBQuery2.FieldByName('IME').Value;
             if not DataModule1.IBQuery2.FieldByName('OTC').IsNull then
                S[3]:=DataModule1.IBQuery2.FieldByName('OTC').Value;
             Text1:=S[1]+' '+S[2]+' '+S[3]+'@';
          Text:=Text+Text1;
             S[1]:=' ';S[2]:=' ';S[3]:=' ';S[4]:=' ';S[5]:=' ';
             S[6]:=' ';S[7]:=' ';S[8]:=' ';S[9]:=' ';
             if not DataModule1.IBQuery2.FieldByName('NPZ').IsNull then
                S[1]:=DataModule1.IBQuery2.FieldByName('NPZ').Value;
             if not DataModule1.IBQuery2.FieldByName('NSP').IsNull then
                S[2]:=DataModule1.IBQuery2.FieldByName('NSP').Value;
             Text1:=S[1]+' '+S[2]+'@';
          Text:=Text+Text1;
             S[1]:=' ';S[2]:=' ';S[3]:=' ';S[4]:=' ';S[5]:=' ';
             S[6]:=' ';S[7]:=' ';S[8]:=' ';S[9]:=' ';
             if not DataModule1.IBQuery2.FieldByName('NNN').IsNull then
                S[1]:=DataModule1.IBQuery2.FieldByName('NNN').Value;
             Text1:=S[1]+'@';
          Text:=Text+Text1;
             S[1]:=' ';S[2]:=' ';S[3]:=' ';S[4]:=' ';S[5]:=' ';
             S[6]:=' ';S[7]:=' ';S[8]:=' ';S[9]:=' ';
          Otchet_Spisok_Sotrudnikov.Gauge1.Progress:=k;
          DataModule1.IBQuery2.Next;
                         end;
 {Передаем строку текста в Word}
     Tempo:=MyRange;
     Par:=Pars.Add(Tempo);
     Par.Range.InsertBefore(Text);
 {Конвертируем текст в таблицу}
     Separator:='@';
     NumColumns:=4;
     MyRange.ConvertToTable(Separator,EmptyParam,NumColumns,EmptyParam,
                            EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                            EmptyParam,EmptyParam,EmptyParam,EmptyParam,
                            EmptyParam,EmptyParam);
 {Связываем переменную и таблицу, а затем меняем размер столбцов и
 выравнивание}
     Tabl:=Otchet_Spisok_Sotrudnikov.WordDocument1.Range.Tables.Item(1);
     Tabl.Columns.Item(1).SetWidth(30,wdAdjustNone);
     Tabl.Columns.Item(2).SetWidth(250,wdAdjustNone);
     Tabl.Columns.Item(3).SetWidth(250,wdAdjustNone);
     Tabl.Columns.Item(4).SetWidth(200,wdAdjustNone);
     Tabl.Range.Paragraphs.Format.Alignment:=wdAlignParagraphCenter;
     Tabl.Range.Cells.VerticalAlignment:=wdAlignParagraphCenter;
     Tempo:=Par.Range.Get_End_; {Определяем конец области}
     MyRange:=Otchet_Spisok_Sotrudnikov.WordDocument1.Range(Tempo);
 {Сохранение документа и отображение его в OLE контейнере (предварительный
 просмотр)}
   Otchet_Spisok_Sotrudnikov.WordDocument1.SaveAs(FileName);
   Otchet_Spisok_Sotrudnikov.WordDocument1.Close;
 {Включить проверки в Word}
 Otchet_Spisok_Sotrudnikov.WordApplication1.Options.CheckSpellingAsYouType:=T
 rue;
 Otchet_Spisok_Sotrudnikov.WordApplication1.Options.CheckGrammarAsYouType:=Tr
 ue;
   Screen.Cursor:=crDefault;
   Otchet_Spisok_Sotrudnikov.Gauge1.Visible:=False;
   Otchet_Spisok_Sotrudnikov.BitBtn1.Visible:=True;
   Otchet_Spisok_Sotrudnikov.OleContainer1.CreateLinkToFile(FileName,false);
   Otchet_Spisok_Sotrudnikov.OleContainer1.Refresh;
 end;
 




Функция DateSer

Привет, я хочу в качестве совета поделиться функцией DateSer, которую я написал перед этим на VB. Данная функция весьма полезна но, к сожалению, ее нет в Delphi. Применяется она так:


 DecodeDate(Date,y,m,d);
 NewDate:=DateSer(y-4,m+254,d+1234);
 

или приблизительно так....


 function DateSer(y, m, d: Integer): TDateTime;
 const
   mj: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31,
     31, 30, 31, 30, 31);
 var
   add: Integer;
 begin
   while (true) do
   begin
     y := y + (m - 1) div 12;
     m := (m - 1) mod 12 + 1;
     if m <= 0 then
     begin
       Inc(m, 12);
       Dec(y);
     end;
     if ((y mod 4 = 0) and
       ((y mod 100 <> 0) or (y mod 400 = 0)))
       and (m = 2) then
       add := 1 //дополнительный день в феврале
     else
       add := 0;
     if (d > 0) and (d <= (mj[m] + add)) then
       break;
     if d > 0 then
     begin
       Dec(d, mj[m] + add);
       Inc(m);
     end
     else
     begin
       Inc(d, mj[m] + add);
       Dec(m);
     end;
   end;
   Result := EncodeDate(y, m, d);
 end;
 




Организация цикла между двумя датами

Звонок в службу технической поддержки:
-Как узнать есть ли у меня "WinCih"?
-Переведите дату на 26 апреля...

TDateTime - вещественное число (дата размещается в левой части числа, до десятичной точки, время - в правой части).

Для организации цикла от StartDate до StopDate, просто напишите:


 trunc(StartDate) to trunc(StopDate)
 




Частичный показ DateTime

Автор: Mike Orriss

Звонок из одной Московской организации в Новосибирскую:
- Пожалуйста, через два часа перешлите такой-то файл по электронной почте!
- А через два часа - это по вашему или по нашему времени?

При отображении TDateTimeField в DBGrid с форматированием hh:mm (для показа только времени), любая попытка изменения времени приводит (при передаче данных) к ошибке примерно такого содержания: "'07:00 is not a valid DateTime" (07:00 - неверный DateTime). Я хотел бы посылать данные приблизительно в таком виде "trunc(oldDateTimevalue)+strtoTime(displaytext)"

Следующий обработчик события TDateTimeField OnSetText не слишком элегантен, но он работает!


 procedure TForm1.Table1Date1SetText(Sender: TField; const Text: String);
 var
   d: TDateTime;
   t: string;
 begin
   t := Text;
   with Sender as TDateTimeField do
   begin
     if IsNull then
       d := SysUtils.Date
     else
       d := AsDateTime;
     AsDateTime := StrToDateTime(Copy(DateToStr(d),1,8)+' '+t);
   end;
 end;
 

Здесь мы исходим из предположения, что у вас имеется маска редактирования, допускающая формат hh:mm или hh:mm:ss.




Формат даты

Format complete... И жадно облизнуться...

У меня есть неотложная задача: в настоящее время я разрабатываю проект, где я должен проверять достоверность введенных дат с применением маски __/__/____, например 12/12/1997.

Некоторое время назад я делал простой шифратор/дешифратор дат, проверяющий достоверность даты. Код приведен ниже.


 function CheckDateFormat(SDate: string): string;
 var
   IDateChar: string;
   x, y: integer;
 begin
   IDateChar := '.,\/';
   for y := 1 to length(IDateChar) do
   begin
     x := pos(IDateChar[y], SDate);
     while x > 0 do
     begin
       Delete(SDate, x, 1);
       Insert('-', SDate, x);
       x := pos(IDateChar[y], SDate);
     end;
   end;
   CheckDateFormat := SDate;
 end;
 
 function DateEncode(SDate: string): longint;
 var
   year, month, day: longint;
   wy, wm, wd: longint;
   Dummy: TDateTime;
   Check: integer;
 begin
   DateEncode := -1;
   SDate := CheckDateFormat(SDate);
   Val(Copy(SDate, 1, pos('-', SDate) - 1), day, check);
   Delete(Sdate, 1, pos('-', SDate));
   Val(Copy(SDate, 1, pos('-', SDate) - 1), month, check);
   Delete(SDate, 1, pos('-', SDate));
   Val(SDate, year, check);
   wy := year;
   wm := month;
   wd := day;
   try
     Dummy := EncodeDate(wy, wm, wd);
   except
     year := 0;
     month := 0;
     day := 0;
   end;
   DateEncode := (year * 10000) + (month * 100) + day;
 end;
 




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



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



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


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