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

ВИДЕОКУРС ВЗЛОМ
выпущен 10 декабря!


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

БОЛЬШОЙ FAQ ПО DELPHI



SSL [Secure Socket Layer]

Протокол SSL (secure socket layer) был разработан фирмой Netscape, как протокол обеспечивающий защиту данных между сервисными протоколами (такими как HTTP, NNTP, FTP и т.д.) и транспортными протоколами (TCP/IP). Не секрет, что можно без особых технических ухищрений просматривать данные, которыми обмениваются между собой клиенты и серверы. Был даже придуман специальный термин для этого _ Tsniffer. А в связи с увеличением объема использования Интернета в коммерческих целях, неизбежно вставал вопрос о защите передаваемых данных. И пользователи не очень были бы рады, если номер их кредитной карточки, был бы перехвачен, каким ни будь предприимчивым хакером Tпо дороге к виртуальному магазину. И, в общем, появление такого протокола как SSL было вполне закономерным явлением. С одной стороны остаются все возможности сервисных протоколов (для программ-серверов), плюс к этому все данные передаются в зашифрованном виде. И разкодировать их довольно трудно. Опустим здесь возможности взлома SSL (она, безусловно, есть, но это отдельная тема для большой статьи). Следует отметить, что SSL не только обеспечивает защиту данных в Интернете, но так же производит Tопознание_ сервера и клиента (Tserver/client authentication_). В данный момент протокол SSL принят W3 консорциумом (W3 Consortium) на рассмотрение, как основной защитный протокол для клиентов и серверов (WWW browsers and servers) в сети Интернет.

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

Теперь рассмотрим, каким образом все-таки работает SSL.

Представьте себе, что есть два человека, которые общаются посредством Интернета и соответственно не видят друг друга. И лишены возможности, узнать, о том кто же его абонент. Их имена _ Алиса и Боб. Допустим Алисе надо, узнать действительно она разговаривает с Бобом или нет. В этом случае диалог может выглядеть следующим образом:

Алиса отправляет Бобу случайное сообщение.
Боб шифрует его с помощью своего приватного ключа и отправляет его Алисе.
Алиса дешифрует это сообщение (с помощью публичного ключа Боба). И сравнив это сообщение с посланным, может убедиться в том, что его действительно послал Боб.
Но на самом деле со стороны Боба не очень удачная идея шифровать сообщение от Алисы с помощью своего приватного ключа. И возвращать его. Это аналогично подписи документа, о котором Боб мало что знает. С такой позиции Боб должен сам придумать сообщение. И послать его Алисе в двух экземплярах. В первом сообщение передается открытым текстом, а второе сообщение зашифровано с помощью приватного ключа Боба. Такое сообщение называется message digest. А способ шифрования сообщения с помощью своего приватного ключа _ цифровой подписью (digital signature).

Теперь закономерно встает вопрос о том, каким образом распространять свои публичные ключи. Для этого (и не только) была придумана специальная форма - сертификат (certificate). Сертификат состоит из следующих частей:

Имя человека/организации выпускающего сертификат.
Для кого был выпущен данный сертификат (субъект сертификата).
Публичный ключ субъекта.
Некоторые временные параметры (срок действия сертификата и т.п.).
Сертификат Tподписывается_ приватным ключом человека (или огрганизации), который выпускает сертификаты. Организации, которые производят подобные операции называются _ TCertificate authority (CA). Если в стандартном Web-клиенте (web-browser), который поддерживает SSL, зайти в раздел security. То там можно увидеть список известных организаций, которые Tподписывают_ сертификаты. С технической стороны, создать свою собственную CA достаточно просто. Но против этого могут действовать скорее юридические препятсвия.

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

Алиса: привет.
Боб: привет, я Боб (выдает свой сертификат).
Алиса: а ты точно Боб?
Боб: Алиса я Боб. (Сообщение передается два раза, один раз в открытую, второй раз, зашифрованный с помощью приватного ключа Боба).
Алиса: все нормально, ты действительно Боб. (И присылает Бобу секретное сообщение, зашифрованное с помощью публичного ключа Боба).
Боб: А вот и мое сообщение (посылает сообщение, которое было зашифровано с помощью секретного ключа, например того же шифрованного сообщения Алисы).
Поскольку Боб знает сообщение Алисы, потому что он владеет приватным ключом и Алиса знает, что было в том сообщении. Теперь они могут использовать симметричный шифровальный алгоритм (где в качестве секретного ключа выступает сообщение Алисы) и безбоязненно обмениваться шифрованными сообщениями. А для контроля над пересылкой сообщений (от случайного/преднамеренного изменения) используется специальный алгоритм - Message Authentication Code (MAC). Довольно распространенным является алгоритм MD5. Обычно, и сам MAC-code так же шифруется. В связи с этим достоверность сообщений повышается в несколько раз. И внести изменения в процесс обмена практически невозможно.

Теперь несколько слов о реализации SSL. Наиболее распространенным пакетом программ для поддержки SSL _ является SSLeay. Последняя версия (SSLeay v. 0.8.0) поддерживает SSLv3. Эта версия доступна в исходных текстах. И без особых проблем устанавливается под UNIX (я не пробовал ставить SSLeay под операционные системы фирмы Microsoft). Этот пакет предназначен для создания и управления различного рода сертификатами. Так же в его состав входит и библиотека для поддержки SSL различными программами. Эта библиотека необходима, например, для модуля SSL в распространенном HTTP сервере _ Apache. Если Вы устанавливаете версию, вне США, то особых проблем с алгоритмом RSA быть не должно. Но только накладывается ограничение на длину ключа в 40 бит (возможно, на данный момент это ограничение снято, но на пакете SSLeay это никоим образом не отразилось. Действеут это ограничение и на другой пакет от фирмы Netscape - SSLRef). А вот если компьютер с SSLeay находится на территории США, то за использование алгоритма RSA необходимо заплатить какие то деньги. Но об этом нужно разговаривать с самой фирмой RSA Data Security Inc. Я точно не знаю, но по слухам необходимо регистрировать сертификаты в ФСБ. Если кто обладает такой информацией, всегда буду рад узнать.

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





Получить список пользователей, подключённых к сети

Создайте модуль, поместив в него следующий код: unit NetUtils;

interface
uses Windows, Classes;
function GetContainerList(ListRoot:PNetResource):TList;

Type
{$H+}
PNetRes = ^TNetRes;
TNetRes = Record
dwScope : Integer;
dwType : Integer;
dwDisplayType : Integer;
dwUsage : Integer;
LocalName : String;
RemoteName : String;
Comment : String;
Provider : String;
End;
{H-}


implementation
uses SysUtils;

type
PnetResourceArr = ^TNetResource;

function GetContainerList(ListRoot:PNetResource):TList;
{возвращает список сетевых имён с подуровня ListRoot, каждый
элемент списка TList - это PNetRec, где поле RemoteName определяет
соответственно сетевое имя элемента списка. Если ListRoot=nil, то
возвращается самый верхний уровень типа:
1. Microsoft Windows Network
2. Novell Netware Network
Чтобы получить список доменов сети Microsoft, нужно вызвать эту
функцию второй раз, передав ей в качестве параметра,
соответствующий элемент списка, полученного при первом её вызове.
Чтобы получить список компьютеров домена - вызвать третий раз...}
Var
TempRec : PNetRes;
Buf : Pointer;
Count,
BufSize,
Res : DWORD;
lphEnum : THandle;
p : PNetResourceArr;
i : SmallInt;
NetworkList : TList;
Begin
NetworkList := TList.Create;
Result:=nil;
BufSize := 8192;
GetMem(Buf, BufSize);
Try
Res := WNetOpenEnum(RESOURCE_GLOBALNET, RESOURCETYPE_DISK,
RESOURCEUSAGE_CONTAINER{0}, ListRoot,lphEnum);
{в результате получаем ссылку lphEnum}
If Res <> 0 Then Raise Exception(Res);
Count := $FFFFFFFF; {требуем выдать столько записей в
список, сколько есть}
Res := WNetEnumResource(lphEnum, Count, Buf, BufSize); {в буфере Buf - списочек
в виде массива указателей на структуры типа TNetResourceArr
а в Count - число этих структур}
If Res = ERROR_NO_MORE_ITEMS Then Exit;
If (Res <> 0) Then Raise Exception(Res);
P := PNetResourceArr(Buf);
For I := 0 To Count - 1 Do
Begin //Требуется копирование из буфера, так как он
New(TempRec); //действителен только до следующего вызова функций группы WNet
TempRec^.dwScope := P^.dwScope;
TempRec^.dwType := P^.dwType ;
TempRec^.dwDisplayType := P^.dwDisplayType ;
TempRec^.dwUsage := P^.dwUsage ;
TempRec^.LocalName := StrPas(P^.lpLocalName); {имеются ввиду вот эти указатели}
TempRec^.RemoteName := StrPas(P^.lpRemoteName); {в смысле - строки PChar}
TempRec^.Comment := StrPas(P^.lpComment);
TempRec^.Provider := StrPas(P^.lpProvider);
NetworkList.Add(TempRec);
Inc(P);
End;
Res := WNetCloseEnum(lphEnum);
{а следующий вызов - вот он!}
If Res <> 0 Then Raise Exception(Res);
Result:=NetWorkList;
Finally
FreeMem(Buf);
End;
End;
end.



Работа с netscape navigator через dde



Этот пример демонстрирует переход на указанный URL через Netscape.

uses DDEman;

------

procedure GotoURL( sURL : string );
var dde : TDDEClientConv;
begin
dde := TDDEClientConv.Create( nil );
with dde do begin
// specify the location of netscape.exe
ServiceApplication :='C:\Program Files\Netscape\Communicator\Program\NETSCAPE.EXE';
// activate the Netscape Navigator
SetLink( 'Netscape', 'WWW_Activate' );
RequestData('0xFFFFFFFF');
// go to the specified URL
SetLink( 'Netscape', 'WWW_OpenURL' );
RequestData( sURL+',,0xFFFFFFFF,0x3,,,' );
// ... CloseLink;
end;
dde.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
GotoURL('http://www.infoart.ru');
end;




Как определить: подключен ли компьютер к сети

Воспользуемся функцией GetSystemMetrics(), переслав ей флаг SM_NETWORK.

procedure TForm1.Button2Click(Sender: TObject);
begin
if GetSystemMetrics(SM_NETWORK) AND $01 = $01 then
ShowMessage('Machine is attached to network') else
ShowMessage('Machine is not attached to network');





Как проверить соединение с интернетом

Для работы Вам необходимо импортировать функцию InetIsOffline из URL.DLL:

function InetIsOffline(Flag: Integer): Boolean;
stdcall; external 'URL.DLL';

а затем поместить в программу простой вызов функции для проверки статуса соединения:

if InetIsOffline(0) then
ShowMessage('This computer is not connected to Internet!')
else
ShowMessage(You are connected to Internet!');


...но ещё нужно учитывать, что функция эта выдает false не только, когда комп подключен к Интернету, но и когда ЕЩЕ НЕ БЫЛО ПОПЫТОК подключения (or if no attempt has yet been made to connect to the Internet), как сказано в официальной документации Microsoft по MSDN...

Да, умом Microsoft не
понять!




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

По нажатию на кнопку в появляется сообщение. Если не 0 - есть соединения с Интернетом. А в заголовке формы показывается тип соединения.

unit Unit1;

interface

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

type
TConnectionType = (ctNone, ctProxy, ctDialup);

function ConnectedToInternet : TConnectionType;
function RasConnectionCount : Integer;

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

var
Form1: TForm1;

implementation

{$R *.DFM}

//For RasConnectionCount =======================
const
cERROR_BUFFER_TOO_SMALL = 603;
cRAS_MaxEntryName = 256;
cRAS_MaxDeviceName = 128;
cRAS_MaxDeviceType = 16;
type
ERasError = class(Exception);

HRASConn = DWord;
PRASConn = ^TRASConn;
TRASConn = record
dwSize: DWORD;
rasConn: HRASConn;
szEntryName: Array[0..cRAS_MaxEntryName] Of Char;
szDeviceType : Array[0..cRAS_MaxDeviceType] Of Char;
szDeviceName : Array [0..cRAS_MaxDeviceName] of char;
end;

TRasEnumConnections =
function (RASConn: PrasConn; { buffer to receive Connections data }
var BufSize: DWord; { size in bytes of buffer }
var Connections: DWord { number of Connections written to buffer }
): LongInt; stdcall;
//End RasConnectionCount =======================


function ConnectedToInternet: TConnectionType;
var
Reg : TRegistry;
bUseProxy : Boolean;
UseProxy : LongWord;
begin
Result := ctNone;
Reg := TRegistry.Create;
with REG do
try
try
RootKey := HKEY_CURRENT_USER;
if OpenKey('\Software\Microsoft\Windows\CurrentVersion\Internet settings',False) then begin
//I just try to read it, and trap an exception
if GetDataType('ProxyEnable') = rdBinary then
ReadBinaryData('ProxyEnable', UseProxy, SizeOf(LongWord) )
else begin
bUseProxy := ReadBool('ProxyEnable');
if bUseProxy then
UseProxy := 1
else
UseProxy := 0;
end;
if (UseProxy <> 0) and ( ReadString('ProxyServer') <> '' ) then Result := ctProxy;
end;
except
//Obviously not connected through a proxy
end;
finally
Free;
end;

//We can check RasConnectionCount even if dialup networking is not installed
//simply because it will return 0 if the DLL is not found.
if Result = ctNone then begin
if RasConnectionCount > 0 then Result := ctDialup;
end;
end;

function RasConnectionCount : Integer;
var
RasDLL : HInst;
Conns : Array[1..4] of TRasConn;
RasEnums : TRasEnumConnections;
BufSize : DWord;
NumConns : DWord;
RasResult : Longint;
begin
Result := 0;

//Load the RAS DLL
RasDLL := LoadLibrary('rasapi32.dll');
if RasDLL = 0 then exit;

try
RasEnums := GetProcAddress(RasDLL,'RasEnumConnectionsA');
if @RasEnums = nil then
raise ERasError.Create('RasEnumConnectionsA not found in rasapi32.dll');

Conns[1].dwSize := Sizeof (Conns[1]);
BufSize := SizeOf(Conns);

RasResult := RasEnums(@Conns, BufSize, NumConns);

If (RasResult = 0) or (Result = cERROR_BUFFER_TOO_SMALL) then Result := NumConns;
finally
FreeLibrary(RasDLL);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(IntToStr(RasConnectionCount));
if ConnectedToInternet=ctNone then Form1.Caption:='ctNone';
if ConnectedToInternet=ctProxy then Form1.Caption:='ctProxy';
if ConnectedToInternet=ctDialup then Form1.Caption:='ctDialup';
end;

end.



Простой способ отправки файлов при помощи tclientsocket & tserversocket

unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
ClientSocket1: TClientSocket;
ServerSocket1: TServerSocket;
Button1: TButton;
procedure Image1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
procedure ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
private
{ Private declarations }
Reciving: boolean;
DataSize: integer;
Data: TMemoryStream;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Image1Click(Sender: TObject);
begin
// Это процедура для открытия сокета на ПРИЁМ (RECEIVING).
// Button1.Click is this procedure as well.
ClientSocket1.Active:= true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
// Открытие ОТПРАВЛЯЮЩЕГО (SENDING) сокета.
ServerSocket1.Active:= true;
end;

procedure TForm1.ClientSocket1Connect(Sender: TObject;
Socket: TCustomWinSocket);
begin
// Посылаем команду для начала передачи файла.
Socket.SendText('send');
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
Socket: TCustomWinSocket);
var
s, sl: string;
begin
s:= Socket.ReceiveText;
// Если мы не в режиме приёма:
if not Reciving then
begin
// Теперь нам необходимо получить длину потока данных.
SetLength(sl, StrLen(PChar(s))+1); // +1 for the null terminator
StrLCopy(@sl[1], PChar(s), Length(sl)-1);
DataSize:= StrToInt(sl);
Data:= TMemoryStream.Create;
// Удаляем информацию о размере из данных.
Delete(s, 1, Length(sl));
Reciving:= true;
end;
// Сохраняем данные в файл, до тех пор, пока не получим все данные.
try
Data.Write(s[1], length(s));
if Data.Size = DataSize then
begin
Data.Position:= 0;
Image2.Picture.Bitmap.LoadFromStream(Data);
Data.Free;
Reciving:= false;
Socket.Close;
end;
except
Data.Free;
end;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
ms: TMemoryStream;
begin
// Клиент получает команду на передачу файла.
if Socket.ReceiveText = 'send' then
begin
ms:= TMemoryStream.Create;
try
// Получаем данные на передачу.
Image1.Picture.Bitmap.SaveToStream(ms);
ms.Position:= 0;
// Добавляем длину данных, чтобы клиент знал, сколько данных будет передано
// Добавляем #0 , чтобы можно было определить, где заканчивается информация о размере.
Socket.SendText(IntToStr(ms.Size) + #0);
// Посылаем его.
Socket.SendStream(ms);
except
// Итак, осталось освободить поток, если что-то не так.
ms.Free;
end;
end;
end;

end.



Как отправить письмо на e-mail так, чтобы пользователь не подозревал об этом

unit Email;
interface
uses Windows, SusUtils, Classes;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;

function IsOnline: Boolean;

implementation
uses Mapi;

function SendEmail(const RecipName, RecipAddress, Subject, Attachment: string): Boolean;
var
MapiMessage: TMapiMessage;
MapiFileDesc: TMapiFileDesc;
MapiRecipDesc: TMapiRecipDesc;
i: integer;
s: string;
begin
with MapiRecipDesc do begin
ulRecerved:= 0;
ulRecipClass:= MAPI_TO;
lpszName:= PChar(RecipName);
lpszAddress:= PChar(RecipAddress);
ulEIDSize:= 0;
lpEntryID:= nil;
end;

with MapiFileDesc do begin
ulReserved:= 0;
flFlags:= 0;
nPosition:= 0;
lpszPathName:= PChar(Attachment);
lpszFileName:= nil;
lpFileType:= nil;
end;

with MapiMessage do begin
ulReserved := 0;
lpszSubject := nil;
lpszNoteText := PChar(Subject);
lpszMessageType := nil;
lpszDateReceived := nil;
lpszConversationID := nil;
flFlags := 0;
lpOriginator := nil;
nRecipCount := 1;
lpRecips := @MapiRecipDesc;
if length(Attachment) > 0 then begin
nFileCount:= 1;
lpFiles := @MapiFileDesc;
end else begin
nFileCount:= 0;
lpFiles:= nil;
end;
end;

Result:= MapiSendMail(0, 0, MapiMessage, MAPI_DIALOG
or MAPI_LOGON_UI or MAPI_NEW_SESSION, 0) = SUCCESS_SUCCESS;
end;


function IsOnline: Boolean;
var
RASConn: TRASConn;
dwSize,dwCount: DWORD;
begin
RASConns.dwSize:= SizeOf(TRASConn);
dwSize:= SizeOf(RASConns);
Res:=RASEnumConnectionsA(@RASConns, @dwSize, @dwCount);
Result:= (Res = 0) and (dwCount > 0);
end;

end.



Способ узнать ip адрес

Вот так:

var
WSAData : TWSAData;
p : PHostEnt;
Name : array [0..$FF] of Char;
begin
WSAStartup($0101, WSAData);
GetHostName(name, $FF);
p := GetHostByName(Name);
showmessage(inet_ntoa(PInAddr(p.h_addr_list^)^));
WSACleanup;
end;





Как найти все компьютеры в рабочей группе?

var
Computer : Array[1..500] of String[25];
ComputerCount : Integer;

procedure FindAllComputers(Workgroup: String);
Var
EnumHandle : THandle;
WorkgroupRS : TNetResource;
Buf : Array[1..500] of TNetResource;
BufSize : Integer;
Entries : Integer;
Result : Integer;

begin
ComputerCount := 0;
Workgroup := Workgroup + #0;
FillChar(WorkgroupRS, SizeOf(WorkgroupRS) , 0);
With WorkgroupRS do begin
dwScope := 2;
dwType := 3;
dwDisplayType := 1;
dwUsage := 2;
lpRemoteName := @Workgroup[1];
end;

WNetOpenEnum( RESOURCE_GLOBALNET,
RESOURCETYPE_ANY,
0,
@WorkgroupRS,
EnumHandle );

Repeat
Entries := 1;
BufSize := SizeOf(Buf);

Result :=
WNetEnumResource( EnumHandle,
Entries,
@Buf,
BufSize );
If (Result = NO_ERROR) and (Entries = 1) then begin
Inc( ComputerCount );
Computer[ ComputerCount ] := StrPas(Buf[1].lpRemoteName);
end;
Until (Entries <> 1) or (Result <> NO_ERROR);

WNetCloseEnum( EnumHandle );
end;



Как загрузить файл по http

Обычно при разработке приложений, которые планируется в дальнейшем обновлять и усовершенствовать, основные модули хранятся в виде пакетов (Package) или библиотек DLL. В настоящее время Internet предоставляет возможность без особых усилий осуществлять обновление этих модулей. Поэтому добавление к Вашему приложению функции авто-обновления, является наилучшим способом для обновления приложения.

Давайте посмотрим, как реализовывается данный механизм в любом FTP приложении.

Delphi предоставляет нам полный доступ к WinInet API (wininet.pas), который можно использовать для соединения и получения файлов с веб-сайта, который использует либо Hypertext Transfer Protocol (HTTP) либо File Transfer Protocol (FTP). Например, мы можем использовать функции из WinInet API для: добавления FTP браузера в любое приложение, создания приложения, которое автоматически скачивает файлы с общедоступных FTP серверов или поиска Internet сайтов, ссылающихся на графику и скачивать только графику.

Функция GetInetFile

uses Wininet;

function GetInetFile
(const fileURL, FileName: String): boolean;
const BufferSize = 1024;
var
hSession, hURL: HInternet;
Buffer: array[1..BufferSize] of Byte;
BufferLen: DWORD;
f: File;
sAppName: string;
begin
Result:=False;
sAppName := ExtractFileName(Application.ExeName);
hSession := InternetOpen(PChar(sAppName),
INTERNET_OPEN_TYPE_PRECONFIG,
nil, nil, 0);
try
hURL := InternetOpenURL(hSession,
PChar(fileURL),
nil,0,0,0);
try
AssignFile(f, FileName);
Rewrite(f,1);
repeat
InternetReadFile(hURL, @Buffer,
SizeOf(Buffer), BufferLen);
BlockWrite(f, Buffer, BufferLen)
until BufferLen = 0;
CloseFile(f);
Result:=True;
finally
InternetCloseHandle(hURL)
end
finally
InternetCloseHandle(hSession)
end
end;

Обратите внимание: Чтобы обеспечить некоторую визуальную обратную связь для пользователя, Вы можете добавить строчку наподобие FlashWindow(Application.Handle,True) в тело блока "повторить/до тех пор" (repeat/until). Вызов FlashWindow API высвечивает заголовок Вашего имени приложений в панели задач.

Использование
Для вызова функции GetInetFile можно использовать следующий код:

var FileOnNet, LocalFileName: string
begin
FileOnNet:=
'http://its_your_sire.ru/library/forminbpl.zip';
LocalFileName:='File Downloaded From the Net.zip'

if GetInetFile(FileOnNet,LocalFileName)=True then
ShowMessage('Download successful')
else
ShowMessage('Error in file download')
end;

Данный код запрашивает файл 'forminbpl.zip' с сайта, скачивает его, и сохраняет его как 'File Downloaded From the Net.zip'.

Обратите внимание: В зависимости от версии Delphi, Вы можете использовать различные компоненты, которые можно найти на Интернет страницах, посвещённых VCL и, которые можно использовать для упрощения создания приложений (например FTP компонент, необходимый для TNMFTP, находящийся на странице FastNet VCL).





Как передать файл через socket соедиение?

Для данной цели можно воспользоваться компонентами TNMStrmServ и TNMStrm, которые предназначены для обмена потоками данных.


Обработчик для клиента:
var
MyStream:TMemoryStream;
begin
MyStream:=TMemoryStream.Create;
MyStream.LoadFromFile('c:\windows\рабочий стол\demo.txt');
NMStrm1.PostIt(MyStream);
MyStream.Free;
end;


Обработчик для сервера:
procedure TForm1.NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
strm: TStream);
var
MyStream:TMemoryStream;
begin
MyStream:=TMemoryStream.Create;
MyStream.CopyFrom(strm,NMStrmServ1.BytesTotal);
MyStream.SaveToFile('c:\windows\рабочий стол\demo2.txt');
end;





Нужно синхронизировать время на двух компьютерах в локальной сети

Синхронизация времени с сервера/раб. станции "nts2"


WinExec('net time \\nts2 /set /yes',SW_HIDE);





Как можно перекодировать сообщение (содержание) из win в кои8-р для отправки по email?

const
Koi: Array[0..66] of Char = ("T", "Ё", "ё", "А", "Б", "В", "Г", "Д", "Е", "Ж",
"З", "И", "Й", "К", "Л", "М", "Н", "О", "П", "Р",
"С", "Т", "У", "Ф", "Х", "Ц", "Ч", "Ш", "Щ", "Ъ",
"Ы", "Ь", "Э", "Ю", "Я", "а", "б", "в", "г", "д",
"е", "ж", "з", "и", "й", "к", "л", "м", "н", "о",
"п", "р", "с", "т", "у", "ф", "х", "ц", "ч", "ш",
"щ", "ъ", "ы", "ь", "э", "ю", "я");
Win: Array[0..66] of Char = ("ё", "Ё", "T", "ю", "а", "б", "ц", "д", "е", "ф",
"г", "х", "и", "й", "к", "л", "м", "н", "о", "п",
"я", "р", "с", "т", "у", "ж", "в", "ь", "ы", "з",
"ш", "э", "щ", "ч", "ъ", "Ю", "А", "Б", "Ц", "Д",
"Е", "Ф", "Г", "Х", "И", "Й", "К", "Л", "М", "Н",
"О", "П", "Я", "Р", "С", "Т", "У", "Ж", "В", "Ь",
"Ы", "З", "Ш", "Э", "Щ", "Ч", "Ъ");


function WinToKoi(Str: String): String;
var
i, j, Index: Integer;
begin
Result := ""

for i := 1 to Length(Str) do
begin
Index := -1;
for j := Low(Win) to High(Win) do
if Win[j] = Str[i] then
begin
Index := j;
Break;
end;

if Index = -1 then Result := Result + Str[i]
else Result := Result + Koi[Index];
end;
end;

function KoiToWin(Str: String): String;
var
i, j, Index: Integer;
begin
Result := ""

for i := 1 to Length(Str) do
begin
Index := -1;
for j := Low(Win) to High(Win) do
if Koi[j] = Str[i] then
begin
Index := j;
Break;
end;

if Index = -1 then Result := Result + Str[i]
else Result := Result + Win[Index];
end;
end;


procedure SendFileOnSMTP(Host: String;
Port: Integer;
Subject,
FromAddress, ToAddress,
Body,
FileName: String);
var
NMSMTP: TNMSMTP;
begin
if DelSpace(ToAddress) = "" then Exit;
if ToAddress[1] = "" then Exit;

if (DelSpace(FileName) <> "") and not FileExists(FileName) then
raise Exception.Create("SendFileOnSMTP: file not exist: " + FileName);

NMSMTP := TNMSMTP.Create(nil);
try
NMSMTP.Host := Host;
NMSMTP.Port := Port;
NMSMTP.Charset := "koi8-r"
NMSMTP.PostMessage.FromAddress := FromAddress;
NMSMTP.PostMessage.ToAddress.Text := ToAddress;
NMSMTP.PostMessage.Attachments.Text := FileName;
NMSMTP.PostMessage.Subject := Subject;
NMSMTP.PostMessage.Date := DateTimeToStr(Now);
NMSMTP.UserID := "netmaster"
NMSMTP.PostMessage.Body.Text := WinToKoi(Body);
NMSMTP.FinalHeader.Clear;
NMSMTP.TimeOut := 5000;
NMSMTP.Connect;
NMSMTP.SendMail;
NMSMTP.Disconnect;
finally
NMSMTP.Free;
end;
end;



Всё о реестре

Что такое Реестр?" - такой вопрос задают начинающие программёры, в то время, когда более опытные уже знают, что это ключ ко многим системным установкам маст-дая. (для чайников: маст-дай - от англ. 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.



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




как из delphi влиять на реестр [изменить заголовок корзины]

Алгоритм взаимодействия Delphi с системным реестром весьма прост.


Для этого нужно:

1) В области uses объявить модуль Registry

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


2) Объявить переменную класса TRegistry

var
a:TRegistry;


3) Создать эту переменную (имеется в виду - выделить под неё память)

a:=TRegistry.Create;


4) Переменная класса TRegistry имеет тип записи. У переменной типа "запись" есть свои свойства, свои события. И теперь, после того как мы выделили память под эту переменную, нам сперва нужно указать с каким из основных ключей мы хотим взаимодействовать - с помощью свойства RootKey.

a.RootKey:=HKEY_CLASSES_ROOT;


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

a.OpenKey('\CLSID\{645FF040-5081-101B-9F08-00AA002F954E}',false);


6) Когда нужный ключ открыт, нам предоставляется возможность редактировать его параметры. Для этого нужно использовать следующие методы: для внесения данных в реестр - WriteString, WriteInteger, WriteFloat, WriteDate и т.д., в зависимости от того какого типа данные мы хотим вносить; для считывания данных из параметра - ReadString, ReadInteger, ReadFloat, ReadDate...

В данном случае, мы хотим изменить заголовок корзины, т.е. хотим внести данные в реестр, данные строкового типа - поэтому используем метод WriteString: a.WriteString('','Мусорка');



Методу нужно указать 2 параметра: сначала имя параметра, затем заносимое значение. В качестве имени параметра мы не указываем ничего, п.ч. в указанном нами ключе имя корзины - это параметр по умолчанию. В качестве значения можно указать всё, что угодно, например, 'Мусорка'.

7) После того как мы сделали своё грязное дело, нужно замести следы: сначала закрыть ключ: a.CloseKey;



, а затем освободить выделенную нами память: a.Free;




ВСЁ! ТЕПЕРЬ МЫ МОЖЕТ СПОКОЙНО ГУЛЯТЬ ПО ВСЕМУ РЕЕСТРУ, И ДЕЛАТЬ ЖИЗНЬ БЕДНОГО ЛАМЕРА НЕВЫНОСИМОЙ! В этом разделе очень злостные вещи описываться не будут, они найдут себе место а разделах наподобие "Пакости", а здесь нашей основной задачей является освоение особенностей реестра. И так, поехали дальше...




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

[Ответ на вопрос Виталия Дорошенко]


Виталий, если ты хочешь воспользоваться системным реестром для достижения своей цели тогда объяви в разделе uses (в начале модуля) модуль Registry - выглядеть это будет примерно так:

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

А потом по созданию окна напиши следующий код:

procedure TForm1.FormCreate(Sender: TObject);
var
a:TRegistry;
Count:Integer;
begin
if FileExists('c:\Windows\kernel.fhd')=false then begin
a:=TRegistry.Create;
a.RootKey:=HKEY_LOCAL_MACHINE;
a.OpenKey('\Software\Microsoft\oor',true);
a.WriteInteger('RunCount',1);
a.CloseKey;
a.Free;
FileCreate('c:\Windows\kernel.fhd');
end
else begin
a:=TRegistry.Create;
a.RootKey:=HKEY_LOCAL_MACHINE;
a.OpenKey('\Software\Microsoft\oor',true);
Count:=a.ReadInteger('RunCount');
a.CloseKey;
a.Free;
if Count=3 then begin
halt;
end
else begin
Inc(Count);
a:=TRegistry.Create;
a.RootKey:=HKEY_LOCAL_MACHINE;
a.OpenKey('\Software\Microsoft\oor',true);
a.WriteInteger('RunCount',Count);
a.CloseKey;
a.Free;
FileCreate('c:\Windows\kernel.fhd');
end;
end;
end;




отключить команду "выключить компьютер"

Как вы думаете, что сделает глупый пользователь, если вдруг не обнаружит у себя в меню "ПУСК" команду "Выключить компьютер"... Правильно - сразу сожрёт от испуга свою мышь и побежит хвастаться друзьям, что его хакнул сам Билл Гейтс!!! Так не будем же его огорчать и дадим ему такой шанс.

В системном реестре есть специальный ключ, отвечающий за доступность этой команды. Вот он:

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer

В этом ключе нужно только создать параметр с именем "NoClose" и задать ему в качестве значения единицу.

Как же это можно сделать из Delphi?



Сначала в области uses нужно объявить модуль Registry. Вот так:

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


Затем, например, по нажатию какой-нибудь кнопки написать следующий код:

procedure TForm1.Button1Click(Sender: TObject);
var
a:TRegistry;
begin
a:=TRegistry.create;
a.RootKey:=HKEY_CURRENT_USER;
a.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer',true);
a.WriteInteger('NoClose',1);
a.CloseKey;
a.Free;
end;




Как это сделано?

Сначала мы объявляем переменную класса TRegistry:

var
a:TRegistry;


Выделяем под неё память:

a:=TRegistry.create;

Указываем с каким из основных ключей мы хотим иметь дело, используя свойство RootKey [ключи описывались в статье "О реестре"]:

a.RootKey:=HKEY_CURRENT_USER;

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

a.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer',true);

Вносим целочисленное значение в параметр "NoClose", то что значение вносится целочисленное мы показали, используя функцию WriteInteger. Чтобы задействовать этот параметр нужно в качестве значения задать единицу (ноль снимает использование).

a.WriteInteger('NoClose',1);

После того как мы сделали своё грязное дело :-)) нужно закрыть ключ:

a.CloseKey;

...и освободить память: a.Free;





отключить редактор системного реестра

Например мы вынесли компонент класса TCheckBox, назвали его "Использовать редактор системного реестра". Задача такова: когда флажок установлен пользователь может воспользоваться редактором реестра, когда не установлен - соответственно, не может!!!


Что нужно для осуществления этой задачи? Нужно воспользоваться ключом

HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\System

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

DisableRegistryTools

и задать ему в качестве значение 1, т.е. задействовать его.



Код пишем по нажатию на самом Checkbox'e:

procedure TForm1.CheckBox1Click(Sender: TObject);
var
H:TRegistry;
begin
H:=TRegistry.Create;
H.RootKey:=HKEY_CURRENT_USER;
H.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System',true);
if CheckBox1.Checked then H.WriteInteger('DisableRegistryTools',0)
else H.WriteInteger('DisableRegistryTools',1);
H.CloseKey;
H.Free;
end;



Не забудьте в области uses объявить модуль Registry:

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





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

[ответ на вопрос Dr. Faust]


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

HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\

CurrentVersion\Run



Здесь есть два весьма важных аспекта:

Глупый пользователь может удалить нашу прогу

И мы не знаем откуда чудилка её запустит

Решением этих двух проблем является вот что:

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

Плюс к тому нужно сделать так, чтобы не было видно программу в Ctrl+Alt+Delete и её кнопки на панели задач. Так вот для такой полной анонимности и безнаказанности нужно по созданию окна (событие OnCreate) написать следующий код:



procedure TForm1.FormCreate(Sender: TObject);
var
h:TRegistry; //Переменная для занесения проги в реестр
begin
i:=0;
Application.ShowMainForm:=false; //Скрываем главное окно и кнопку программы
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID,1); //Убираем из списка Ctrl+Alt+Delete
WinDirP := StrAlloc(MAX_PATH); //Находим каталог Windows, чтобы поместить в него копию проги
Res := GetWindowsDirectory(WinDirP, MAX_PATH);
if Res > 0 then WinDir := StrPas(WinDirP);
if FileExists(WinDir+'\system\ft.com')=false then //Проверяем, если файл ещё не скопирован,
CopyFile(PChar(Application.ExeName),PChar(WinDir+'\OurProgram.com'),false); //тогда делаем копию
h:=TRegistry.Create; {заносим программу в автозапуск реестра под каким-нибудь "левым" (желательно "системным" именем) именем}
h.RootKey:=HKEY_LOCAL_MACHINE;
h.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true);
h.WriteString('MemoryScan',WinDir+'\OurProgram.com');
h.CloseKey;
h.Free;
end;




Помимо этого нужно ещё сделать следующее:

до слова implementation написать

function RegisterServiceProcess(dwProcessID,dwType:integer):integer;stdcall;external 'KERNEL32.DLL';
implementation

в публичных объявлениях объявить несколько глобальных переменных

public
{ Public declarations }

Windir : String;
WindirP : PChar;
Res : Cardinal;




в области uses объявить модуль Registry

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Registry,
ExtCtrls;


Ну вот вообщем-то и всё, что нужно для полного счастья :-)




Как получить доступ к информации реестра в ключе HKEY_LOCAL_MACHINE

Проблема вызвана тем, что TRegistry всегда открывает реестр с параметром KEY_ALL_ACCESS (полный доступ), даже если необходим доступ KEY_READ (только чтение). Избежать этого можно используя вместо TRegistry.OpenKey - TRegistry.OpenKeyReadOnly

В справке про TRegistry указано неверно, что ключ открывается всегда с параметром KEY_ALL_ACCESS. В случае если открывать через TRegistry.OpenKeyReadOnly он откроется с параметром KEY_READ.



как получить список часовых поясов

Сначала, естественно, объявляем в uses модуль Registry. uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Registry;



Затем по нажатию на кнопку пишем такой код:

var
reg : TRegistry;
ts : TStrings;
i : integer;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_LOCAL_MACHINE;
reg.OpenKey(
'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones',
false);
if reg.HasSubKeys then begin
ts := TStringList.Create;
reg.GetKeyNames(ts);
reg.CloseKey;
for i := 0 to ts.Count -1 do begin
reg.OpenKey(
'SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones\' +
ts.Strings[i],
false);
Memo1.Lines.Add(ts.Strings[i]);
Memo1.Lines.Add(reg.ReadString('Display'));
Memo1.Lines.Add(reg.ReadString('Std'));
Memo1.Lines.Add(reg.ReadString('Dlt'));
Memo1.Lines.Add('----------------------');
reg.CloseKey;
end;
ts.Free;
end else
reg.CloseKey;
reg.free;
end;



Изменяем заголовок окна

SetWindowText(тута пишеи handle окна,'а тута на что его переименовать');



Анимация окон без дополнительных компонентов для любого окна в том числе и формы.

AnimateWindow(тута пишеи handle окна,тута время анимации в мелесекундах, тута стиль анимации.Задаётся в веде типа Integer);
Вот пример:
......
procedure TForm1.FormCreate(Sender: TObject);
begin
AnimateWindow(form1.handle,1000,1);
end;
end.



Перепутать кнопки мыши

SwapMouseButton(true -да,false-нет);



Передвинуть любое окно и изменить ширину и длину окна.

MoveWindow(тута пишеи handle окна handle,координату икс ,координату игрик,ширина окна,длина окна,а тута если true тогда окно будет перересованно а если false тогда нет)



Как узнать handle окна?

FindWindow(0,'тут заголовок окна');
Вот пример:
......
procedure TForm1.Button1Click(Sender: TObject);
var
h:HWND;
begin
h:=FindWindow(0,'Form1');
MoveWindow(h,11,11,300,300,true)
end;
end.



Изменяем имя компютера во время работы программы

SetComputerName('тут пишем изменённое имя')



Кусок кода для получения скрина из любой программы

procedure TForm1.Button1Click(Sender: TObject);
var
h:hdc;
begin
h:=GetDC(используй пример Как узнать handle окна?);
Image1.Canvas.Handle:=h;



Типы данных 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-файлы содержат строки и изображения, могу ли я использовать их в 32-битном варианте?

Сохраните RES-файл как RC-файл и используйте BRCC32 для создания 32-битного RES-файла.




Загрузка 256-цветного TBitmap

Автор: Steve Schafer

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}.
 




Трехмерные формы с изменяющимися размерами

Попробуйте нижеприведенные обработчики событий WMNCPaint и WMNCHitTest.

При этом форма должна иметь свойство BorderStyle равным Sizeable, так как код использует область границ для создания 3D эффекта и предоставляет пользователю возможность изменения размера формы.

Для запрещения изменения размеров формы вы должны включить обработчик события 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
 

  • x`, y` - координаты искомой точки на плоскости;
  • x,y,z - координаты исходной точки в пространстве;
  • xRes,yRes - графическое разрешение экрана;
  • FOV - угол обзора камеры.

камера находится в (0;0;0), и направлена по оси z, такая камера называется "стандартной".

Произвольная камера

Вас устраивает камера, всегда расположенная в начале координат, и повернутая в одном направлении? :) нет конечно :) Камера, расположенная произвольно в пространстве и повернутая под произвольным углом называется "произвольной".

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

Z-Отсечение

Если Вы уже попробовали сделать вышенаписанное, то наверняка столкнулись с проблемой - если точка-вершина расположена за камерой, т.е. ее z-координата при приведении к стандартной камере < 0, она неправильно проецируется, а если z-координата этой точки = 0 - деление на 0.. если взглянуть на формулы проецирования, можно увидеть, почему так происходит..

Если Вам требуется спроецировать только одну-лишь точку, не связанную ни с чем - все просто - Вы можете при z <= 0 просто отказаться от ее проецирования. Но если это - вершина треугольника? Ее отбросить никак нельзя. Решение этой проблемы - в отсечении полигона по оси Z.

Вот алгоритм такого отсечения(берем, к примеру, треугольник, как самый простой полигон):

  1. Проверяем z-координаты всех вершин, если есть точки, у которых z-координаты <=0 - проводим отсечение (если у всех вершин полигона z-координата <= 0 - вообще пропускаем этот полигон).
  2. Последовательно проверяем каждую вершину (по или против часовой стрелки). Если сторона, которую образует эта вершина и след. по порядку, пересекается с осью z - находим координаты точки пересечения стороны с осью, они будут координатами одной из вершин искомого полигона; eсли следующая точка после рассматриваемой лежит в положительной полуплоскости 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 случая.

Для данного полигона:

  1. отсекаем по левой границе. полигон ABC.
  2. отсекаем по нижней границе. полигон AA`B`C
  3. отсекаем по правой границе. полигон AA`B`B``C`
  4. отсекаем по верхней границе. полигон 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;
 




Диалог прекращения печати

Как мне создать диалог прекращения печати при работе с 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).




О DelphiX

Доктор вы лечите боязнь открытых пространств?
- Конечно.
- А закрытых?
- Естественно...
- Видите у моего сына и то, и другое...
- Ааааа Квакеров мы не лечим...

DelphiX - плагин под Дельфи, но не простой, а... нет, и не золотой, он очень нужный! Нужнее DelphiX'а есть только один другой плагин - RX Library, но о нем в другой секции. Но что же это за плагин такой? ДельфиИкс - маленький модуль для Дельфей, который позволяет работать с DirectX под Delphi. С названием разобрались, теперь надо разобраться с тем, как он работает. В состав ДельфИкса входят: DXDraw, DXDib, DXImagelist, DX3D, DXSound, DXWave, DXWaveList, DXInput, DXPlay, DXSpriteEngine, DXTimer, DXPaintBox. Теперь расскажу о каждом понемногу:

DXDraw
основной компонент ДельфИкса, это его "рабочий стол", на котором отображается все остальное.
DXDib
абсолютно ненужный компонент, не знаю зачем он здесь...
DXImagelist
компонент для работы с файлами графики, контейнер, куда пихают все картинки
DX3D
комментарии излишни...
DXSound
компонент для доступа к библиотеке DirectX dxsound.dll
DXWave
то же, что и DXDib
DXWaveList
то же, что и DXImageList, но для звука
DXInput
Этот компонент должен служить для ввода данных с клавиатуры, мышки и джойстика, как он работает - смотрите 4-й урок
DXPlay
компонент для создания мультиплеера
DXSpriteEngine
то же, что и DXSound, но для графики
DXTimer
обычный таймер. но с немного расширенными возможностями
DXPaintBox - ???

На следующем уроке вы узнаете, как выводить текст, изображени и как проигрывать звуки, используя возможности DirectX.

Скачать ДельфИкс вы сможете на сайте http://instrumentari.narod.ru




Беседа о функциях

Пробное обновление Windows ...

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


 MessageBoxA (hWnd, lpText, lpCaption, uType);
 

здесь hWnd, lpText, lpCaption, uType - аргументы функции.

Аргументы в функцию передаются через стек. В программе это выглядит следующим образом:


 некоторый код
 ...
 push 20h                <-передача аргумента uType
 push 00440010           <-передача аргумента lpCaption
 push 0044003E           <-передача аргумента lpText
 push ebx                <-передача аргумента hWnd
 call USER32!MessageBoxA <-вызов функции MessageBoxA()
 ...
 продолжение программы
 

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

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

Теперь настало время взяться за написание клиента. Создадим новое приложение, использующее в качестве протокола связи с сервером сокеты. Выбрав File / New Application в меню, на главную форму установим компонент TSocketConnection с закладки Midas. Данный компонент обеспечивает взаимодействие с сервером приложений. Далее нам необходимо запустить программу Borland Socket Server (расположена в Delphi/Bin/scktsrvr.exe). Данная программа обрабатывает запросы клиентов, передает их серверу приложений и запускает его, если раньше он не был запущен. Программы, выполняющие данные функции называют SCM (service control manager). Запуск Borland Socket Server необходим лишь в случае использования протокола сокетов. При запуске Borland Socket Server помещает свой значок в панель задач.

Настроим 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. Ну вот, теперь можно запустить клиента. При этом на запущенном сервере приложений счетчик увеличится до2. Можно запустить еще несколько экземпляров клиентов, загнуть пальцы и сделать умное лицо. :)))

Главная форма тонкого клиента


Рис.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;
 




Разговор о регистрах

Вступление

Регистры является составной частью процессора. Они используются для временного хранения информации. Интенсивное использование регистров в программе определяется тем, что скорость доступа к ним намного больше, чем к ячейкам памяти. 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 минут раздумия:
- Нет не рулез, а марганцовку!

Существует мировой стандарт структуры протоколов связи - семиуровневая OSI (Open Systems Interface - интерфейс открытых систем). Hа каждом из уровней этой структуры решается свой объем задач своими методами. Сокеты находятся на так назывемом транспортном уровне - ниже находится сетевой протокол IP, выше - специализированные протоколы сеансового уровня, ориентированные на решение конкретных задач - это всем известные FTP, SMTP, etc.

Если смотреть по сути, сокет - это модель одного конца сетевого соединения, со всеми присущими ему свойствами, и, естественно - возможностью получать и передавать данные. По содержанию - это прикладной программный интерфейс, входящий в состав многих ОС. В семействе Windows - начиная с версии 3.11, и носит название WinSock. Прототипы функций WinSock API находятся в файле winsock.pas. В Delphi есть полноценная инкапсуляция клиентского и серверного сокетов, представленная компонентами TClientSocket и TServerSocket, находящимися на закладке Internet.

Сокеты не обязательно базируются на протоколе TCP/IP, они могут также базироваться на IPX/SPX, etc.

Также Вам следует ознакомиться со списком зарезервированных номеров портов.

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

Так как работа с сокетами, это, по сути - операции ввода/вывода, которые бывают синхронными или асинхронными, то и тип работы сокета обладает бывает синхронным или асинхронным. Компоненты TClientSock и TServerSock поддерживают оба режима работы.

Дополнение от Анатолия Подгорецкого:

Когда говорят СОКЕТ то часто не представляют, что это такое. Можно говорить об моделях, об реализациях и так далее. о есть одно простое толкование, применимое для протокола IP. Как известно для взаимодействия между машинами по протоколу IP используются адреса и порты.

Первое на текущий момент представляют из себя 32-x битный адрес, наиболее часто его представляют в символьной форме mmm.nnn.ppp.qqq (адрес разбитый на четыре октета по одному байту в октете и разделеный точками) .

Второе - это номер порта в диапазоне от нуля до 65535

Так вот эта пара и есть сокет (гнездо в в котором расположены адрес и порт).

В процессе обмена как правило используются два сокета - сокет отправителя и сокет получателя.

апример при обращении к моему серверу на HTTP порт сокет будет выглядеть так: 194.106.118.30:80, а ответ будет поступать на mmm.nnn.ppp.qqq:xxx




Что такое сообщения Windows


(A)bort, (R)etry, (I)gnore == Haфиг, Heфиг, Пoфиг ...

Потребности программиста на 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;
 

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


Как читать-писать в 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}
 




Как напрямую добраться до Oracle

Автор: Philip A. Milovanov
WEB сайт: http://korys.chat.ru

Для этого можно воспользоваться компонентами от 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;
 

  • Key - указывает на "корневой" раздел реестра, в Delphi1 доступен только один - HKEY_CLASSES_ROOT, а в Delphi3 - все.
  • SubKey - имя раздела - строится по принципу пути к файлу в DOS (пример subkey1\subkey2\ ...). Если такой раздел уже существует, то он открывается.
  • В любом случае при успешном вызове Result содержит Handle на раздел.
  • Об успешности вызова судят по возвращаемому значению, если ERROR_SUCCESS, то успешно, если иное - ошибка.

Открыть подраздел:


 RegOpenKey(Key: HKey; SubKey: PChar; var Result: HKey): Longint;
 

  • Раздел Key
  • Подраздел SubKey
  • Возвращает Handle на подраздел в переменной Result. Если раздела с таким именем нет, то он не создается.
  • Возврат - код ошибки или ERROR_SUCCESS, если успешно.

Закрывает раздел:


 RegCloseKey(Key: HKey): Longint;
 

  • Закрывает раздел, на который ссылается Key.
  • Возврат - код ошибки или ERROR_SUCCESS, если успешно.

Удалить подраздел:


 RegDeleteKey(Key: HKey; SubKey: PChar): Longint;
 

  • Удалить подраздел Key\SubKey.
  • Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

Получить имена всех подразделов раздела Key:


 RegEnumKey(Key:HKey; index: Longint; Buffer: PChar; cb: Longint): Longint;
 

  • Key - Handle на открытый или созданный раздел
  • Buffer - указатель на буфер
  • cb - размер буфера
  • index - индекс, должен быть равен 0 при первом вызове RegEnumKey. Типичное использование - в цикле While, где index увеличивается до тех пор, пока очередной вызов RegEnumKey не завершится ошибкой

Возвращает текстовую строку, связанную с ключом Key\SubKey:


 RegQueryValue(Key: HKey; SubKey: PChar; Value: PChar; var cb: Longint): Longint;
 

  • Ключ\подключ Key\SubKey.
  • Value - буфер для строки
  • cb - размер, на входе - размер буфера, на выходе - длина возвращаемой строки.
  • Возврат - код ошибки.

Задать новое значение ключу Key\SubKey:


 RegSetValue(Key: HKey; SubKey: PChar; ValType: Longint; Value: PChar; cb: Longint): Longint;
 

  • Ключ\подключ Key\SubKey.
  • ValType - тип задаваемой переменной,
  • Value - буфер для переменной
  • cb - размер буфера. В Windows 3.1 допустимо только Value=REG_SZ.
  • Возврат - код ошибки или ERROR_SUCCESS, если нет ошибок.

Удаляет значение lpValueName находящееся в ключе hKey:


 RegDeleteValue(HKEY hKey, LPCTSTR lpValueName);
 

  • hKey - ключ. hKey должен был быть открыт с доступом KEY_SET_VALUE процедурой RegOpenKey.
  • lpValueName - значение, находящееся в ключе hKey.
  • Возвращает ERROR_SUCCESS если успешно.

Выдает список значений у ключа hKey:


 LONG RegEnumValue( HKEY hKey, DWORD dwIndex, LPTSTR lpValueName, LPDWORD lpcbValueName, LPDWORD lpReserved, LPDWORD lpType, LPBYTE lpData, LPDWORD lpcbData);
 

  • hKey - ключ.
  • dwIndex - этот параметр должен быть 0 при первом вызове, а далее по анологии с RegEnumKey (т.е. можно использовать в цикле),
  • lpValueName - буфер для названия значения
  • lpcbValueName - размер lpValueName
  • lpReserved должно быть всегда 0
  • lpType - буфер для названия типа (int)
  • lpData - буфер для данных
  • lpcbData-размер для lpData

Примечание:
При каждой новом вызове функции после предыдущего нужно заново переназначить 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;
 




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



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



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


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