Доброго времени суток , уважаемые читатели!

Ну вот и свершилось долгожданное чудо! Наш сайт предстал перед вами в новой форме! Заходите, смотрите, высказывайте свои мнения в гостевой книге или на мыло. Хочу отдельно сказать, что изменено не только оформление, но и полностью переработана структура расположения файлов. В связи с этим, ссылки, ранее опубликованные в выпусках рассылки, теперь недействительны, так что будьте внимательны. Все присланные ранее вопросы и ответы, конечно же, опубликованы в данном выпуске рассылки. Однако теперь ответы на вопросы будут публиковаться только в рассылке, на сайте вы найдёте только вопросы. Но к вопросам указаны номера выпусков рассылки, в которых публиковались ответы на эти вопросы. Скачать все выпуски рассылки вы можете со страницы Архив рассылки. Заходите на наш форум и обсуждайте интересующие темы. Отдельно хочу попросить всех: если на сайте не работает какая-либо из ссылок или не скачивается файл, пожалуйста, сообщите об этом. Ну вот и всё, что хотел сказать... Оставляю вас наедине с рассылкой и свеженьким сайтом. Удачи!

Количество подписчиков: 1864.

Читатели, лидирующие по количеству баллов:

За конкурс с вопросами по Delphi баллы пока никому не начислены. Это будет сделано чуть позже.

Основные правила нашей рассылки:
1. Не присылайте ответов на вопросы вроде "да я не знаю" или "да/нет". Такие ответы не публикуются.
2. Вопросы, не касающиеся Delphi, не принимаются (для этого существуют другие рассылки).
3. Запрещено присылать вложенные файлы, размером более 100 Кб, без предварительной связи с администратором.
4. Не изменяйте тем присылаемых писем. Письма с "неправильными" темами не публикуются! Используйте текстовый формат писем.

Новые вопросы.

78. Как получить скорость работы GPU и памяти видео карты? [Ответить].

79. Как программно установить свои обои? [Ответить].

80. Привет всем! у меня возникла такая вот проблемка. Есть база данных, созданная в MS Access, которая содержит 2 поля, в одном картинки, во втором текст. При подключении этой базы в Делфи7 (используются ADO компоненты), появляется ошибка Bitmap image is not valid. Подскажите, что делать? Связь с БД есть, т.к. текст она показывает. Пробовала менять форматы картинок и в JPG, и в разные BMP. Ничего не помогло. [Ответить].

81. Здравствуйте! У меня такой вопрос - как при запуске приложения автоматически присоединить .dllку ? Если регистрировать её через regsvr32.exe с помощью WinExec, то будет вылезать уведомление о регистрации dllки. И ещё один нюанс - эта dll в разных операционках лежит в разных каталогах, а может и вообще отсутствовать! Т.е. нужно присоединять dll из корневого каталога программы. (?) Заранее спасибо. Удачи! [Ответить].

82. Подскажите, как получить оцифровку сигнала с линейного входа звуковой карты в реальном времени (без записи в файл WAV и последующего его декодирования)? Спасибо. [Ответить].

83. Как можно рисовать (вывести текст) на экран, не на элемент окна, а именно на экран? Узнал, что нужно что-то делать с видеопамятью, только вот что и как? [Ответить].

84. Необходимо, чтобы программа "замечала" установления модемом соединения (с инетом например). То есть связь установилась, появилось уведомление в виде двух мониторов в трэе, и прога, заметив это, например закрылась. Надо бы ещё и дисконект "замечать" и имя соединения узнавать не помешало бы. Я не имею ни малейшего понятия о том, как это осуществить. Подскажите пожалуйста. [Ответить].

85. Пишу на D7: база данных по работе с кадрами предприятия , использую ADO, SQL Server Sybase ASA Anywhere 9 на NetWare 6. Или я устарел, или отупел. Вопрос: как можно обновить только одну строку (запись), используя ADO при редактировании записи? Refresh обновляет все. При обновлении Close, Open, обновляются все записи, происходят тормоза, а нодо только одну. Заранее спасибо. [Ответить].

86. Друзья программисты! Порекомендуйте книгу по Delphi, рассчитанную на новичка. [Ответить].

Ответы на вопросы.

71. (Отправка SMS). [Отвечает: Feniks]: Вряд ли такие компоненты существуют, потому что отправку SMS-сообщений на телефон через E-Mail разрешает и регулирует сам оператор сотовой связи абонента, на телефон которого ты собираешься отправлять сообщение. Не все операторы поддерживают такой сервис, а некоторые еще и блокируют эту функцию по желанию своих клиентов (абонентов). Например, в моей стране, в Украине, существует несколько операторов и у каждого по-своему. Если оператор поддерживает эту функцию, то, обычно, письмо отправляется на адрес следующего формата: <номер телефона>@<сервак оператора>, где номер телефона может быть как в международном формате, так и в сокращенном, без кода страна и оператора, а только внутренний номер в сети - это все зависит от оператора. А <сервак оператора> - это их специальных почтовый сервер, причем может быть различным для разных клиентов одного оператора. Например: для контрактников - <код страны><код оператора><1234567>@sms.server.operator для предоплаченого - сервиса <код страны><код оператора><1234567>@2sms.server.operator у другого оператора - 1234567@sms.server.operator. Как видишь, в каждой стране и у каждого оператора свои заморочки. К тому же, есть операторы, у которых вообще нет сервиса SMS. ИМХО, лучше использовать готовые проги для отправки СМС-ок. У них есть своя база, в которой перечислены страны, операторы и форматы адресов для отправки СМС через E-Mail. P.S. Такая же кухня и с MMS сообщениями. Еще можно отправить MMS и SMS сообщения с родного сайта оператора.

77. (Проблемы при чтении данных из реестра). [Отвечает: Iron Monk]: Всем привет!

Var reg:Tregistry;
. . .
reg:=TRegistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
// так будет работать
reg.OpenKey(‘Program’,true)
if reg.ReadString('Program')= 'Какая то строка' then

[Отвечает: Igor]: Ошибка происходит потому, что у вас не прав администратора при выполнении программы, а без прав администратора раздел HKEY_LOCAL_MACHINE доступен только для чтения!

[Отвечает: Yurchik]: Если нужно создать какой-либо новый раздел в корне HKEY_LOCAL_MACHINE - ничего не выйдет. Но зато вполне можно воспользоваться веткой SOFTWARE и создавать новые разделы там. Если же вообще не удается открыть ни один ключ в HKEY_LOCAL_MACHINE, то проблема состоит в следущем. При использованиии компонента TRegistry под NT пользователь с правами доступа ниже чем "администратор" не может получить доступа к информации реестра в ключе HKEY_LOCAL_MACHINE. Проблема вызвана тем, что TRegistry по умолчанию открывает реестр с параметром KEY_ALL_ACCESS (полный доступ). Нужно изменить свойство Access на KEY_READ (только чтение) либо непосредственно перед чтением данных из реестра (reg.Access:= KEY_READ;), либо при создании экземпляра объекта (reg:= TRegistry.Create(KEY_READ);)

[Отвечает: Feniks]: Наверняка ты работаешь в Windows 2000 или XP, т.е. в NT-юхах, а в этих виндах нельзя создавать новые ключи в HKEY_LOCAL_MACHINE, что ты и пытаешься сделать: If reg.OpenKey('Program', true) then ... Используй один из уже существующих ключах для создания в нем твоего 'Program'. Например : If reg.OpenKey('SoftWare\Program', true) then ...

75. (Скрытие программы от диспетчера задач Windows). [Отвечает: Iron Monk]: Всем привет! Библиотека убирает процесс из диспетчера задач. Компиллируем библиотеку dll и сохраняем её под именем Hide.dll:

library Hide;

uses
Windows,
SysUtils,
ImageHlp,
TlHelp32;

type SYSTEM_INFORMATION_CLASS = (
SystemBasicInformation,
SystemProcessorInformation,
SystemPerformanceInformation,
SystemTimeOfDayInformation,
SystemNotImplemented1,
SystemProcessesAndThreadsInformation,
SystemCallCounts,
SystemConfigurationInformation,
SystemProcessorTimes,
SystemGlobalFlag,
SystemNotImplemented2,
SystemModuleInformation,
SystemLockInformation,
SystemNotImplemented3,
SystemNotImplemented4,
SystemNotImplemented5,
SystemHandleInformation,
SystemObjectInformation,
SystemPagefileInformation,
SystemInstructionEmulationCounts,
SystemInvalidInfoClass1,
SystemCacheInformation,
SystemPoolTagInformation,
SystemProcessorStatistics,
SystemDpcInformation,
SystemNotImplemented6,
SystemLoadImage,
SystemUnloadImage,
SystemTimeAdjustment,
SystemNotImplemented7,
SystemNotImplemented8,
SystemNotImplemented9,
SystemCrashDumpInformation,
SystemExceptionInformation,
SystemCrashDumpStateInformation,
SystemKernelDebuggerInformation,
SystemContextSwitchInformation,
SystemRegistryQuotaInformation,
SystemLoadAndCallImage,
SystemPrioritySeparation,
SystemNotImplemented10,
SystemNotImplemented11,
SystemInvalidInfoClass2,
SystemInvalidInfoClass3,
SystemTimeZoneInformation,
SystemLookasideInformation,
SystemSetTimeSlipEvent,
SystemCreateSession,
SystemDeleteSession,
SystemInvalidInfoClass4,
SystemRangeStartInformation,
SystemVerifierInformation,
SystemAddVerifier,
SystemSessionProcessesInformation
);

_IMAGE_IMPORT_DESCRIPTOR = packed record
case Integer of
0:(
Characteristics: DWORD);
1:(
OriginalFirstThunk:DWORD;
TimeDateStamp:DWORD;
ForwarderChain: DWORD;
Name: DWORD;
FirstThunk: DWORD);
end;
IMAGE_IMPORT_DESCRIPTOR=_IMAGE_IMPORT_DESCRIPTOR;
PIMAGE_IMPORT_DESCRIPTOR=^IMAGE_IMPORT_DESCRIPTOR;

PFARPROC=^FARPROC;

procedure ReplaceIATEntryInOneMod(pszCallerModName: Pchar; pfnCurrent: FarProc; pfnNew: FARPROC; hmodCaller: hModule);
var ulSize: ULONG;
pImportDesc: PIMAGE_IMPORT_DESCRIPTOR;
pszModName: PChar;
pThunk: PDWORD; ppfn:PFARPROC;
ffound: LongBool;
written: DWORD;
begin
pImportDesc:= ImageDirectoryEntryToData(Pointer(hmodCaller), TRUE,IMAGE_DIRECTORY_ENTRY_IMPORT, ulSize);
if pImportDesc = nil then exit;
while pImportDesc.Name<>0 do
begin
pszModName := PChar(hmodCaller + pImportDesc.Name);
if (lstrcmpiA(pszModName, pszCallerModName) = 0) then break;
Inc(pImportDesc);
end;
if (pImportDesc.Name = 0) then exit;
pThunk := PDWORD(hmodCaller + pImportDesc.FirstThunk);
while pThunk^<>0 do
begin
ppfn := PFARPROC(pThunk);
fFound := (ppfn^ = pfnCurrent);
if (fFound) then
begin
VirtualProtectEx(GetCurrentProcess,ppfn,4,PAGE_EXECUTE_READWRITE,written);
WriteProcessMemory(GetCurrentProcess, ppfn, @pfnNew, sizeof(pfnNew), Written);
exit;
end;
Inc(pThunk);
end;
end;

var
addr_NtQuerySystemInformation: Pointer;
mypid: DWORD;
fname: PCHAR;
mapaddr: PDWORD;
hideOnlyTaskMan: PBOOL;

function myNtQuerySystemInfo(SystemInformationClass: SYSTEM_INFORMATION_CLASS; SystemInformation: Pointer;
SystemInformationLength:ULONG; ReturnLength:PULONG):LongInt; stdcall;
label onceagain, getnextpidstruct, quit, fillzero;
asm
push ReturnLength
push SystemInformationLength
push SystemInformation
push dword ptr SystemInformationClass
call dword ptr [addr_NtQuerySystemInformation]
or eax,eax
jl quit
cmp SystemInformationClass, SystemProcessesAndThreadsInformation
jne quit

onceagain:
mov esi, SystemInformation

getnextpidstruct:
mov ebx, esi
cmp dword ptr [esi],0
je quit
add esi, [esi]
mov ecx, [esi+44h]
cmp ecx, mypid
jne getnextpidstruct
mov edx, [esi]
test edx, edx
je fillzero
add [ebx], edx
jmp onceagain

fillzero:
and [ebx], edx
jmp onceagain

quit:
mov Result, eax
end;

procedure InterceptFunctions;
var hSnapShot: THandle;
me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
if hSnapshot=INVALID_HANDLE_VALUE then exit;
try
ZeroMemory(@me32,sizeof(MODULEENTRY32));
me32.dwSize:=sizeof(MODULEENTRY32);
Module32First(hSnapShot,me32);
repeat
ReplaceIATEntryInOneMod('ntdll.dll',addr_NtQuerySystemInformation,@MyNtQuerySystemInfo,me32.hModule);
until not Module32Next(hSnapShot,me32);
finally
CloseHandle(hSnapShot);
end;
end;

procedure UninterceptFunctions;
var hSnapShot: THandle;
me32: MODULEENTRY32;
begin
addr_NtQuerySystemInformation:=GetProcAddress(getModuleHandle('ntdll.dll'),'NtQuerySystemInformation');
hSnapShot:=CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,GetCurrentProcessId);
if hSnapshot=INVALID_HANDLE_VALUE then exit;
try
ZeroMemory(@me32,sizeof(MODULEENTRY32));
me32.dwSize:=sizeof(MODULEENTRY32);
Module32First(hSnapShot,me32);
repeat
ReplaceIATEntryInOneMod('ntdll.dll',@MyNtQuerySystemInfo,addr_NtQuerySystemInformation,me32.hModule);
until not Module32Next(hSnapShot,me32);
finally
CloseHandle(hSnapShot);
end;
end;

var HookHandle: THandle;

function CbtProc(code: integer; wparam: integer; lparam: integer):Integer; stdcall;
begin
Result:=0;
end;

procedure InstallHook; stdcall;
begin
HookHandle:=SetWindowsHookEx(WH_CBT, @CbtProc, HInstance, 0);
end;

var hFirstMapHandle:THandle;

function HideProcess(pid:DWORD; HideOnlyFromTaskManager:BOOL):BOOL; stdcall;
var addrMap: PDWORD;
ptr2: PBOOL;
begin
mypid:=0;
result:=false;
hFirstMapHandle:=CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,8,'NtHideFileMapping');
if hFirstMapHandle=0 then exit;
addrMap:=MapViewOfFile(hFirstMapHandle,FILE_MAP_WRITE,0,0,8);
if addrMap=nil then
begin
CloseHandle(hFirstMapHandle);
exit;
end;
addrMap^:=pid;
ptr2:=PBOOL(DWORD(addrMap)+4);
ptr2^:=HideOnlyFromTaskManager;
UnmapViewOfFile(addrMap);
InstallHook;
result:=true;
end;

exports
HideProcess;

var
hmap: THandle;
UnoHide:String;
procedure LibraryProc(Reason: Integer);

begin

if Reason = DLL_PROCESS_DETACH then
if mypid > 0 then
UninterceptFunctions()
else
CloseHandle(hFirstMapHandle);
end;

begin
hmap:=OpenFileMapping(FILE_MAP_READ,false,'NtHideFileMapping');
if hmap=0 then exit;
try
mapaddr:=MapViewOfFile(hmap,FILE_MAP_READ,0,0,0);
if mapaddr=nil then exit;
mypid:=mapaddr^;
hideOnlyTaskMan:=PBOOL(DWORD(mapaddr)+4);
if hideOnlyTaskMan^ then
begin
UnoHide:='taskmgr.exe';
fname:=allocMem(MAX_PATH+1);
GetModuleFileName(GetModuleHandle(nil),fname,MAX_PATH+1);
if not (ExtractFileName(fname)=UnoHide) then exit;
end;
InterceptFunctions;
finally
UnmapViewOfFile(mapaddr);
CloseHandle(Hmap);
DLLProc:=@LibraryProc;
end;
end.

А это наша программа:

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
function HideProcess(pid: DWORD; HideOnlyFromTaskManager: BOOL): BOOL; stdcall; external 'hide.dll';

procedure TForm1.Button1Click(Sender: TObject);
begin
HideProcess(GetCurrentProcessId, false); //это спрячет текущий процесс
end;
end.

[Отвечает: mfred]: Вот так и убираешm:

function RegisterServiceProcess(ProcessID, Typ: Integer): Integer;
external 'KERNEL32.DLL';

procedure TForm1.Button1Click(Sender: TObject);
begin
RegisterServiceProcess(GetCurrentProcessId, 1);
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
GetWindowLong(Application.Handle, GWL_EXSTYLE) or
WS_EX_TOOLWINDOW);
end;

[Отвечает: Igor]: Убрать программу из Диспетчера задач WINDOWS:

1. Убрать из списка приложений: Убрать в главной форме в приложении стиль WS_Ex_AppWindow. Если форм несколько, то, возможно, нужно убрать у всех:

type
TMainForm = class(TForm)
. . .
public
{ Public declarations }
procedure CreateParams(var Params :TCreateParams); override;
end;
. . .
procedure TMainForm.CreateParams(var Params :TCreateParams);
begin
inherited CreateParams(Params);
Params.ExStyle := Params.ExStyle and not WS_Ex_AppWindow;
end;

После того, как форма появится на экране (можно в событии OnShow): прописать строчку: ShowWindow(Application.Handle, SW_HIDE);

Но есть одно но: если окно формы свернуть, то в списке приложений ваша программа все же появится. Поэкспериментируйте, где лучше всего поместить эту строчку. Я пробовал в OnPaint, но это не самый лучший способ. Либо, что еще лучше: напишите свой обработчик.

2. Убрать из списка процессов: В Windows этого не предусмотрено, т.к. сокрытие процесса совсем нежелательно (можно выполнять любые действия без ведома юзера).

В Windows 98 еще можно было запустить процесс, как сервис, теперь в XP это намного сложнее.

В интернете есть статьи, посвященные сокрытию процесса, например: http://www.hackzona.ru/modules.php?name=News&file=article&sid=1300

[Отвечает: Dasha]: Есть один способ, но он работает только в Windows 9x. Нужно сделать програму процессом, чтобы она отображалась только в диспетчере задач, а потом объявить после users такую процедуру:

procedure RegisterServiceProcess; external 'kernel32.dll'
name 'RegisterServiceProcess';

А в программе вызвать ее:

asm
push 1
push 0
call RegisterServiceProcess;
end;

Тут ассемблером немного проще вызывать. В Windows 2000/XP нет такой функции, поэтому там работать не будет.

[Отвечает: Андрей Лучников]: {Вот где-то когда-то нарыл примерчик}

program Project1;

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


{$R *.RES}
var
ExtendedStyle : integer;
begin
Application.Initialize;
ExtendedStyle:=GetWindowLong(application.Handle, GWL_EXSTYLE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
ExtendedStyle or WS_EX_TOOLWINDOW);
Application.CreateForm(TForm1, Form1);
Application.Run;
end.

[Отвечает: PWL]: Конечно, отключить Ctrl+Alt+Del - это круто... Например, по созданию окна. Для этого до слова implementation впиши следующую функцию:

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

А на создание окна код будет выглядеть так:

procedure TForm1.FormCreate(Sender: TObject);
begin
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 1);
end;

Ну вот и всё, а если тебе понадобится сделать прогу видимой, тогда сделай это так:

procedure TForm1.Button1Click(Sender: TObject);
begin
if not(csDesigning in ComponentState) then
RegisterServiceProcess(GetCurrentProcessID, 0);
end;

[Отвечает: Gin]: Не сочтите за труд - посмотрите в конце ответа на Вопрос №54:

procedure TForm1.Button2Click(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_SHOW);
end;

Но можно и в момент запуска:

procedure TForm1.FormShow(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_Hide);
end;

или

procedure TForm1.FormActivate(Sender: TObject);
begin
ShowWindow(Application.Handle,SW_Hide);
end;

На странице "Процессы" Диспетчера Задач приложение не будет отображаться.

74. (Подсчёт суммарной температуры за день и за месяц в StringGrid). [Отвечает: Dasha]: Для этого делаем две процедуры для подсчета по дням и месяцам. Такие вот:

procedure CountDay;
var
i, j, sumday: integer;
temp: string;
begin
for i:=0 to MainForm.StringGrid1.rowcount-1 do
begin
temp:=MainForm.StringGrid1.cells[0,i];
sumday:=0;
for j:=0 to MainForm.StringGrid1.RowCount-1 do
if MainForm.StringGrid1.Cells[0,j]=temp then
sumday:=sumday+StrToInt(MainForm.StringGrid1.Cells[1,j]);
MainForm.StringGrid1.cells[2,i]:=IntToStr(sumday);
end;
end;

procedure CountMonth;
var
i, j, summonth: integer;
temp, AMonth, AYear, TMonth, TYear: string;
begin
for i:=0 to MainForm.StringGrid1.RowCount-1 do
begin
temp:=MainForm.StringGrid1.cells[0,i];
TMonth:=Copy(temp,4,2);
TYear:=Copy(temp,7,4);
summonth:=0;
for j:=0 to MainForm.StringGrid1.RowCount-1 do
begin
AMonth:=Copy(MainForm.StringGrid1.cells[0,j],4,2);
AYear:=Copy(MainForm.StringGrid1.cells[0,j],7,4);
if (TMonth=AMonth) and (TYear=AYear) then
summonth:=summonth+StrToInt(MainForm.StringGrid1.cells[1,j]);
end;
MainForm.StringGrid1.cells[3,i]:=IntToStr(SumMonth);
end;
end;

А потом где-нибудь просто их вызвать.

[Отвечает: PWL]: Привет... В принципе, у меня похожее было, и я использовал вот что:

procedure TForm1.FormActivate(Sender: TObject);
begin
tabl.Cells[0,0]:='Число';
tabl.Cells[1,0]:='1 Замер';
tabl.Cells[2,0]:='2 Замер';
tabl.Cells[3,0]:='3 Замер';
tabl.Cells[4,0]:='Всего дней в месяце';
tabl.Cells[5,0]:='Всего чего-то';
tabl.Cells[6,0]:='Средняя ЗА день';
end;

procedure TForm1.Button1Click(Sender: TObject);
var
c,r:integer; // номер колонки и строки таблицы
s:integer; // всего
p:integer;
tab1, tab2, tab3, tab4 : Extended;

begin
for r:=1 to tabl.rowcount do // обработать все строки
begin
s:=0;
// вычисляем общее кол-во
for c:=1 to 4 do
if tabl.cells[c,r] <> ''
then s:=s+StrToInt(tabl.cells[c,r])
else tabl.cells[c,r]:='0';

// вычисляем количество
p:=StrToInt(tabl.cells[1,r])+
StrToInt(tabl.cells[2,r])+
StrToInt(tabl.cells[3,r]);

// вывод результата

tab4:=StrToFloat(tabl.cells[4,r]); // всего дней в месяце

tabl.cells[5,r]:=IntToStr(p);

// Передаем значение ячейки в переменную
tab1:=StrToFloat(tabl.cells[1,r]);
tab2:=StrToFloat(tabl.cells[2,r]);
tab3:=StrToFloat(tabl.cells[3,r]);
// вычесление средней температуры дня
tabl.Cells[6,r]:=(FloatToStr((tab1+tab2+tab3)/3)) ;
end;
end;
end.

Если что-то не понятно, напиши на PWLdeHAK@gmail.com я тебе исходник брошу ...

76. (Получение IP-адресов компьютера). [Отвечает: Автор рассылки]: Посмотрите вопрос №42 в нашей рассылке.

68. (Формирование уникального номера CD). [Отвечает: Feniks]: А зачем все так усложнять ? Ведь есть стандартные способы по определению серийного номера компакт-диска. Этот номер является заводским и уникальным. Самый простой и банальный способ рассматривался в одной предыдущей рассылке. Или можешь попробовать следующее:

var
RetVal : BOOL;
i : Byte;
Drives : DWORD;
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
RootPathName : PChar;

Drives := GetLogicalDrives;
for i := 2 to 25 do
begin
if (Drives and Trunc(Power(2.0,i))) > 0 then // Does Drive "i" exist?
begin
// Drive exists, convert i to a root path name (e.g., convert 2 to 'C:\')
RootPathName := PChar(Char(i + 65) + ':\');

// Get the volume information
RetVal := GetVolumeInformation(
RootPathName, // address of root directory of the file system
nil, // address of name of the volume
0, // length of lpVolumeNameBuffer
@VolumeSerialNumber, // address of volume serial number
MaximumComponentLength, // address of system's maximum filename length
FileSystemFlags, // address of file system flags
nil, // address of name of file system
0 // length of lpFileSystemNameBuffer
);

// if the call was successful, add the serial number.
if RetVal then
begin
ShowMessage('CD Serial Number = '+VolumeSerialNumber);
end;
end; // If
end; // For

Вы также можете ответить на предыдущие вопросы. Поскольку на них уже ответили как минимум раз, они больше не публикуются в рассылке. Но если вы можете что-то добавить к ответам других, пожалуйста, отвечайте - ответы будут опубликованы. Найти предыдущие вопросы вы можете на нашем сайте: http://www.delphi-faq.fatal.ru/ или в спец-выпусках рассылки.

Статья по Delphi.

Создание хранителя экрана (ScreenSaver)

Главное о чем стоит упомянуть это, что ваш хранитель экрана будет работать в фоновом режиме и он не должен мешать работе других запущенных программ. Поэтому сам хранитель должен быть как можно меньшего объема. Для уменьшения объема файла в описанной ниже программе не используются визуальные компоненты Delphi; включение хотя бы одного из них приведет к увеличению размера файла свыше 200кб, а так описанная ниже программа имеет размер всего 20кб!!!
    Технически, хранитель экрана является нормальным EXE файлом (с расширением .SCR), который управляется через командные параметры строки. Например, если пользователь хочет изменить параметры вашего хранителя, Windows выполняет его с параметром "-c" в командной строке. Поэтому начать создание вашего хранителя экрана следует с создания примерно следующей функции:

Procedure RunScreenSaver;
Var S : String;
Begin
  S := ParamStr(1);
  If (Length(S) > 1) Then Begin
    Delete(S,1,1); { delete first char - usally "/" or "-" }
    S[1] := UpCase(S[1]);
  End;
  LoadSettings; { load settings from registry }
  If (S = 'C') Then RunSettings
  Else If (S = 'P') Then RunPreview
  Else If (S = 'A') Then RunSetPassword
  Else RunFullScreen;
End;
      

Procedure RunFullScreen;
Var
  R          : TRect;
  Msg        : TMsg;
  Dummy      : Integer;
  Foreground : hWnd;
Begin
  IsPreview := False;  MoveCounter := 3;  
  Foreground := GetForegroundWindow;
  While (ShowCursor(False) > 0) do ;
  GetWindowRect(GetDesktopWindow,R);
  CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,0);
  CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);
  SystemParametersInfo(spi_ScreenSaverRunning,1,@Dummy,0);
  While GetMessage(Msg,0,0,0) do Begin
    TranslateMessage(Msg);
    DispatchMessage(Msg);
  End;
  SystemParametersInfo(spi_ScreenSaverRunning,0,@Dummy,0);
  ShowCursor(True);
  SetForegroundWindow(Foreground);
End;

Function CreateScreenSaverWindow(Width,Height : Integer;  
  ParentWindow : hWnd) : hWnd;
Var WC : TWndClass;
Begin
  With WC do Begin
    Style := cs_ParentDC;
    lpfnWndProc := @PreviewWndProc;
    cbClsExtra := 0;  cbWndExtra := 0; hIcon := 0; hCursor := 0;
    hbrBackground := 0; lpszMenuName := nil; 
    lpszClassName := 'MyDelphiScreenSaverClass';
    hInstance := System.hInstance;
  end;
  RegisterClass(WC);
  If (ParentWindow  0) Then
    Result := CreateWindow('MyDelphiScreenSaverClass','MySaver', 
      ws_Child Or ws_Visible or ws_Disabled,0,0, 
      Width,Height,ParentWindow,0,hInstance,nil)
  Else Begin
    Result := CreateWindow('MyDelphiScreenSaverClass','MySaver', 
      ws_Visible or ws_Popup,0,0,Width,Height, 0,0,hInstance,nil);
    SetWindowPos(Result,hwnd_TopMost,0,0,0,0,swp_NoMove or swp_NoSize or swp_NoRedraw);
  End;
  PreviewWindow := Result;
End;

Procedure RunPreview;
Var
  R             : TRect;
  PreviewWindow : hWnd;
  Msg           : TMsg;
  Dummy         : Integer;
Begin
  IsPreview := True;
  PreviewWindow := StrToInt(ParamStr(2));
  GetWindowRect(PreviewWindow,R);
  CreateScreenSaverWindow(R.Right-R.Left,R.Bottom-R.Top,PreviewWindow);
  CreateThread(nil,0,@PreviewThreadProc,nil,0,Dummy);
  While GetMessage(Msg,0,0,0) do Begin
    TranslateMessage(Msg); DispatchMessage(Msg);
  End;
End;

Function PreviewThreadProc(Data : Integer) : Integer; StdCall;
Var R : TRect;
Begin
  Result := 0; Randomize;
  GetWindowRect(PreviewWindow,R);
  MaxX := R.Right-R.Left;  MaxY := R.Bottom-R.Top;
  ShowWindow(PreviewWindow,sw_Show); UpdateWindow(PreviewWindow);
  Repeat
    InvalidateRect(PreviewWindow,nil,False);
    Sleep(30);
  Until QuitSaver;
  PostMessage(PreviewWindow,wm_Destroy,0,0);
End;

Function PreviewWndProc(Window : hWnd; Msg,WParam,
  LParam : Integer): Integer; StdCall;
Begin
  Result := 0;
  Case Msg of
    wm_NCCreate  : Result := 1;
    wm_Destroy   : PostQuitMessage(0);
    wm_Paint     : DrawSingleBox; { paint something }
    wm_KeyDown   : QuitSaver := AskPassword;
    wm_LButtonDown, wm_MButtonDown, wm_RButtonDown, wm_MouseMove : 
                   Begin
                     If (Not IsPreview) Then Begin
                       Dec(MoveCounter);
                       If (MoveCounter <= 0) Then QuitSaver := AskPassword;
                     End;
                   End;
     Else Result := DefWindowProc(Window,Msg,WParam,LParam);
  End;
End;

Function AskPassword : Boolean;
Var
  Key   : hKey;
  D1,D2 : Integer; { two dummies }
  Value : Integer;
  Lib   : THandle;
  F     : TVSSPFunc;
Begin
  Result := True;
  If (RegOpenKeyEx(hKey_Current_User,'Control Panel\Desktop',0, 
      Key_Read,Key) = Error_Success) Then 
  Begin
    D2 := SizeOf(Value);
    If (RegQueryValueEx(Key,'ScreenSaveUsePassword',nil,@D1, 
        @Value,@D2) = Error_Success) Then 
    Begin
      If (Value  0) Then Begin
        Lib := LoadLibrary('PASSWORD.CPL');
        If (Lib > 32) Then Begin
          @F := GetProcAddress(Lib,'VerifyScreenSavePwd');
          ShowCursor(True);
          If (@F  nil) Then Result := F(PreviewWindow);
          ShowCursor(False);
          MoveCounter := 3; { reset again if password was wrong }
          FreeLibrary(Lib);
        End;
      End;
    End;
    RegCloseKey(Key);
  End;
End;

Procedure RunSettings;
Var Result : Integer;
Begin
  Result := DialogBox(hInstance,'SaverSettingsDlg',0,@SettingsDlgProc);
  If (Result = idOK) Then SaveSettings;
End;

SaverSettingsDlg DIALOG 70, 130, 166, 75
STYLE WS_POPUP | WS_DLGFRAME | WS_SYSMENU
CAPTION "Settings for Boxes"
FONT 8, "MS Sans Serif"
BEGIN
    DEFPUSHBUTTON "OK", 5, 115, 6, 46, 16
    PUSHBUTTON "Cancel", 6, 115, 28, 46, 16
 CTEXT "Box &Color:", 3, 2, 30, 39, 9
    COMBOBOX 4, 4, 40, 104, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS
    CTEXT "Box &Type:", 1, 4, 3, 36, 9
    COMBOBOX 2, 5, 12, 103, 50, CBS_DROPDOWNLIST | CBS_HASSTRINGS
    LTEXT "Boxes Screen Saver for Win32 Copyright (c) 1996 Jani
           Jдrvinen.", 7, 4, 57, 103, 16,
           WS_CHILD | WS_VISIBLE | WS_GROUP
END

Function SettingsDlgProc(Window : hWnd; Msg,WParam,LParam : Integer): Integer; StdCall;
Var S : String;
Begin
  Result := 0;
  Case Msg of
    wm_InitDialog : Begin
                      { initialize the dialog box }
                      Result := 0;
                    End;
    wm_Command    : Begin
                      If (LoWord(WParam) = 5) Then EndDialog(Window,idOK)
                      Else If (LoWord(WParam) = 6) Then EndDialog(Window,idCancel);
                    End;
    wm_Close      : DestroyWindow(Window);
    wm_Destroy    : PostQuitMessage(0);
    Else Result := 0;
  End;
End;

Procedure SaveSettings;
Var
  Key   : hKey;
  Dummy : Integer;
Begin
  If (RegCreateKeyEx(hKey_Current_User,
                     'Software\SilverStream\SSBoxes',
                     0,nil,Reg_Option_Non_Volatile,
                     Key_All_Access,nil,Key,
                     @Dummy) = Error_Success) Then Begin
    RegSetValueEx(Key,'RoundedRectangles',0,Reg_Binary, 
     @RoundedRectangles,SizeOf(Boolean));
    RegSetValueEx(Key,'SolidColors',0,Reg_Binary, @SolidColors,SizeOf(Boolean));
    RegCloseKey(Key);
  End;
End;

Procedure LoadSettings;
Var
  Key   : hKey;
  D1,D2 : Integer; { two dummies }
  Value : Boolean;
Begin
  If (RegOpenKeyEx(hKey_Current_User,
                   'Software\SilverStream\SSBoxes',0,
                   Key_Read,
                   Key) = Error_Success) Then Begin
    D2 := SizeOf(Value);
    If (RegQueryValueEx(Key,'RoundedRectangles',nil,@D1,
        @Value, @D2) = Error_Success) Then 
    Begin   
      RoundedRectangles := Value;
    End;
    If (RegQueryValueEx(Key,'SolidColors',nil,@D1,
        @Value,@D2) = Error_Success) Then 
    Begin
      SolidColors := Value;
    End;
    RegCloseKey(Key);
  End;
End;

Procedure RunSetPassword;
Var
  Lib : THandle;
  F   : TPCPAFunc;
Begin
  Lib := LoadLibrary('MPR.DLL');
  If (Lib > 32) Then Begin
    @F := GetProcAddress(Lib,'PwdChangePasswordA');
    If (@F  nil) Then F('SCRSAVE',StrToInt(ParamStr(2)),0,0);
    FreeLibrary(Lib);
  End;
End;

Procedure DrawSingleBox;
Var
  PaintDC  : hDC;
  Info     : TPaintStruct;
  OldBrush : hBrush;
  X,Y      : Integer;
  Color    : LongInt;
Begin
  PaintDC := BeginPaint(PreviewWindow,Info);
  X := Random(MaxX); Y := Random(MaxY);
  If SolidColors Then
    Color := GetNearestColor(PaintDC,RGB(Random(255),Random(255),Random(255)))
  Else Color := RGB(Random(255),Random(255),Random(255));
  OldBrush := SelectObject(PaintDC,CreateSolidBrush(Color));
  If RoundedRectangles Then
    RoundRect(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y),20,20)
  Else Rectangle(PaintDC,X,Y,X+Random(MaxX-X),Y+Random(MaxY-Y));
  DeleteObject(SelectObject(PaintDC,OldBrush));
  EndPaint(PreviewWindow,Info);
End;

Var
  IsPreview         : Boolean;
  MoveCounter       : Integer;
  QuitSaver         : Boolean;
  PreviewWindow     : hWnd;
  MaxX,MaxY         : Integer;
  RoundedRectangles : Boolean;
  SolidColors       : Boolean;

program MySaverIsGreat;
uses
   windows, messages, Utility; { defines all routines }
{$R SETTINGS.RES}
begin
  RunScreenSaver; 
end.

Присылайте свои статьи по адресу delphi-faq@list.ru с темой 'Article' (без кавычек), и они будут опубликованы в ближайших выпусках рассылки. Также вы можете заполнить вот эту форму. Большая просьба: статью оформляйте в -txt или -doc формате и используйте -zip или -rar сжатие (без самораспаковки).

Download.

Из данного раздела Вы можете скачать различные файлы: компоненты, plug-in'ы для Delphi, документацию по программированию, программы, игры, написанные на Delphi и всё остальное... Вы можете добавить свои файлы в данный раздел, будем очень признательны! Чтобы сделать это, пожалуйста, заполните форму на сайте. Когда администратор ответит Вам и даст согласие на добавление файла(ов), тогда Вы их и пришлёте. Убедительная просьба соблюдать все вышеописанные правила.

В связи с обновлением сайта никакие из разделов не пополнены. Приведены ссылки и описания всех файлов, находящихся в данный момент на сайте.

Дружественные сайты.

Юмор.

"Кто юзал мой логин и весь его выюзал?"

* * *

Компьютерная эзотерика: перед тем, как процессор сгорит, в его памяти
проносятся все операции, которые он когда-либо совершил.

* * *

Слышь... это... www.zarplaty.net?
- www.kak.vsegda.net!
- www.kak.zhe.ya.domoy.po.edu?
- www.pesh.com!

* * *

Дочь пpосит И-нетчика:
- Папа, посмотpи пожалyйста, какая на yлице погода.
- Сейчас, - ответил тот и набpал в бpаyзеpе "http://weather.cnn.com".

* * *

Сын программиста подходит к отцу и спрашивает:
- Пап, а что такое "пингвин"?
Папа (задумчиво):
- Пинг... Вин... Пинг винды, значит. Функция для определения зависания винды.

Присылайте свои "компьютерные" анекдоты по этой ссылке: Delphi-FAQ@list.ru и они обязательно будут опубликованы!