» Вопросы по Delphi (до версии 2009) - часть 6

Maks150988
Для преобразования в строку уже есть функция StrPas. Или даже проще: "To convert a null terminated string to an AnsiString or native Delphi language string, use a typecast or an assignment."
_http://docs.embarcadero.com/products/rad_studio/delphiAndcpp2009/HelpUpdate2/EN/html/delphivclwin32/SysUtils_StrPas@PAnsiChar.html
Но для этого лучше выделять память на 1 байт больше, чем требуется для чтения, чтобы в этом последнем байте гарантированно был null (символ с кодом 0).

И перед выходом из функции, явно очистите память за собой SetLength(pByteData, 0);

А насчет того, что не весь _большой_ файл скачивается, то вы явно не обратили внимание на замену

Код: bRet := InternetQueryDataAvailable(hResourceHandle, dwBytesToWrite, 0, 0);
if (bRet and (dwBytesToWrite > 0)) then

Подскажите, получает-ли приложение какие-нибудь сообщения, когда его убивают, допустим через диспетчер задач?
(можно ли отловить сей момент?)

Aleksandr N
Если используется TerminateProcess, то нет.

Frodo_Torbins
Жаль, известные мне методы убийства, в том числе "диспетчер задач" используют именно TerminateProcess.

Frodo_Torbins

Цитата:

Если используется TerminateProcess, то нет.

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

Программка для нахождения прямоугольных форм в сканнере. Бесплатная. Отечественная.
http://cc.embarcadero.com/Item/28352

Подскажите пожалуйста, как задать цвет окна через HWND?
Смысл такой - есть вызываемая функция, которая обрабатывет окно именно через хендл, нужно внутри этой-же функции к тому-же окну задать цвет. Насколько это возможно?

Gnom3
Я думаю PostMessage(HWND, WM_MYCOLOR, Color, 0);

delover
Я думаю
WM_CTLCOLORDLG
более подходит

Забыл сказать (точнее. на тот момент не знал ) окно VCL'ное - это както влияет на способ закрашивания?
ShIvADeSt, delover, спасибо за помощ

ShIvADeSt
Спасибо за уточнение я хотел сказать что Post а не Send.

Цитата:

PostMessage(HWND, WM_MYCOLOR, Color, 0);

В общем, ситуация такая, на Windows 7 данное сообщение не принимается окном, видимо, в семействе 6 изменились какието условия. Закрашивать окна мне нужно именно на Windows Vista-7. Есть еще какаято возможность?

Gnom3
Окно должно быть специально "обучено" принимать такие сообщения. То есть оно должно содаржать код, реагирующий на WM_MYCOLOR.
Если же у вас нет возможности изменить исходный код нужного приложения, то придется искать другие пути. Вы хоть в его адресном пространстве работаете?

Frodo_Torbins
Ээ, приложение, окно которого я хочу закрасить, умеет принимать сообщения, например такое:

Код: hM:= GetSystemMenu(WizardForm.Handle, false);
DeleteMenu(hM, $F060, 0);

Gnom3
Цитата:

Ээ, приложение, окно которого я хочу закрасить, умеет принимать сообщения

Стандартные конечно, а WM_MYCOLOR - не стандартное.

В вашем случае еще можно попробовать провернуть все это дело через RTTI, если приложение делфевое. Для этого нужна только ссылка на объект, которую можно получить с помощью FindControl.

Цитата:

которую можно получить с помощью FindControl.

а на прямую подать не получится? В моем случае, это будет WizardForm.Handle, либо WizardForm - аналог Applucation. Окно дельфовое, VCL'ное.
Сразу оговорюсь - я только учусь, и без примеров плохо понимаю ...

Gnom3
Если у вас уже есть ссылка на объект нужного класса, то конечно FindControl не нужен. А если вы еще и компилируете в той же самой версии делфи, что и целевое приложение, то можно и без RTTI обойтись. Особенно, если рантайм пакеты включены.

Цитата:

А если вы еще и компилируете в той же самой версии делфи, что и целевое приложение

Целевое приложение компилируется в одном из интерпретаторов дельфи, с сильно урезанным языком, от того и заморочки такие. Можно и в этом интерпретаторе сделать основную функцию (у меня это получалось) но тормоза великие. Есть еще вариант - сразу закрашивать окно - у него есть свойство -Color - на данный момент так и делаю, но в моем случае это не самое элегантное решение.

Gnom3
То есть вы пишете скрипт, выполняющийся интерпретатором нужного приложения? Тогда чем вас не устраивает работа со свойством Color?

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

Вот моя функция в дельфи:
[more=код]function AddHandlefunction(const AHandle: HWND; const AMarginsLeft,
AMarginsRight, AMarginsTop, AMarginsBottom: integer): Boolean;stdcall;
type
_MARGINS = packed record
cxLeftWidth: integer;
cxRightWidth: integer;
cyTopHeight: integer;
cyBottomHeight: integer;
end;
PMargins = ^_MARGINS;
TMargins = _MARGINS;

var
Color: integer;
DLLHandle: THandle;
Margins :TMargins;
DwmExtendFrameIntoClientAreaProc: function(destWnd: HWND;const pMarInset: PMargins): HRESULT;stdcall;

begin Result := False;
if IsWindowsVistaOrLater and CompositingEnabled then
begin
DLLHandle := LoadLibrary(dwmapi);
if DLLHandle <> 0 then begin
@DwmExtendFrameIntoClientAreaProc := GetProcAddress(DLLHandle,DwmExtendFrameIntoClientAreaSig);
if (@DwmExtendFrameIntoClientAreaProc <> nil) then begin
zeromemory(@Margins, SizeOf(Margins));
// попытка закрасить окно по хендлу
PostMessage(AHandle,WM_CTLCOLORDLG,0,$000000);
// поля, к которым будет применена основная функция
Margins.cxLeftWidth := AMarginsLeft;
Margins.cxRightWidth := AMarginsRight;
Margins.cyTopHeight := AMarginsTop;
Margins.cyBottomHeight := AMarginsBottom;
if DwmExtendFrameIntoClientAreaProc(AHandle, @Margins) = 0 then Result := True;
end;
FreeLibrary(DLLHandle);
end;
end;
end;[/more]

Цитата:

Тогда чем вас не устраивает работа со свойством Color?

Эээ... Может, упрямством? Я знаю, что это было решено, похожая длл-ка есть, но меня не устраивает функционал версии, которая в паблике доступна, отчего и затеял все это дело. Плюс, функции, поданные в Inno Setup из внешних длл-ок, работают значительно быстрее, чем написанные в Inno Setup, что очень благотворно сказывается на нервах конечных пользователей.

Gnom3
Получается, вам нужно закрасить черным окошко инносетюпа? Можно попробовать повесить хук на сообщения отрисовки окна. Но по хорошему поддержка Аэро должна реализовываться самим приложением. Извне ее нормально прикрутить не получится. Я бы на вашем месте уже давно взялся править исходники инно.

Цитата:

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

Не дорос еще я до этого. Плюс - уже сделано это уважаемым товарищем Vo1t. В личной беседе, он дал ссылку на исходник, в котором не нужно бороться с цветом окна, но я так и не смог осилить экспорт - там функция применяется не к хендлу, а к форме, переделка на хендл результата не дала, поскольку часть параметров применяется только к форме, обойти через TCanvas не удалось.
Вот эта функция, может, знающие товарищи подскажут, где может быть ошибка?
[more=код]procedure GlassForm(HandleW:HWND; cBlurColorKey: TColor); stdcall;
const
WS_EX_LAYERED = $80000;
LWA_COLORKEY = 1;

type
_MARGINS = packed record
cxLeftWidth: Integer;
cxRightWidth: Integer;
cyTopHeight: Integer;
cyBottomHeight: Integer;
end;
PMargins = ^_MARGINS;
TMargins = _MARGINS;

DwmIsCompositionEnabledFunc = function(pfEnabled: PBoolean): HRESULT; stdcall;
DwmExtendFrameIntoClientAreaFunc = function(destWnd: HWND; const pMarInset: PMargins): HRESULT; stdcall;
SetLayeredWindowAttributesFunc = function(destWnd: HWND; cKey: TColor; bAlpha: Byte; dwFlags: DWord): BOOL; stdcall;

var
hDWMDLL: Cardinal;
osVinfo: TOSVERSIONINFO;
fDwmIsCompositionEnabled: DwmIsCompositionEnabledFunc;
fDwmExtendFrameIntoClientArea: DwmExtendFrameIntoClientAreaFunc;
fSetLayeredWindowAttributesFunc: SetLayeredWindowAttributesFunc;
bCmpEnable: Boolean;
mgn: TMargins;


begin
ZeroMemory(@osVinfo, SizeOf(osVinfo));
OsVinfo.dwOSVersionInfoSize := SizeOf(TOSVERSIONINFO);

if ((GetVersionEx(osVInfo) = True) and (osVinfo.dwPlatformId = VER_PLATFORM_WIN32_NT) and (osVinfo.dwMajorVersion >= 6)) then
begin
hDWMDLL := LoadLibrary('dwmapi.dll');

if hDWMDLL <> 0 then
begin
@fDwmIsCompositionEnabled := GetProcAddress(hDWMDLL, 'DwmIsCompositionEnabled');
@fDwmExtendFrameIntoClientArea := GetProcAddress(hDWMDLL, 'DwmExtendFrameIntoClientArea');
@fSetLayeredWindowAttributesFunc := GetProcAddress(GetModulehandle(user32), 'SetLayeredWindowAttributes');

if ((@fDwmIsCompositionEnabled <> nil) and (@fDwmExtendFrameIntoClientArea <> nil) and (@fSetLayeredWindowAttributesFunc <> nil)) then
begin
fDwmIsCompositionEnabled(@bCmpEnable);

if bCmpEnable = True then
begin
Canvas := TCanvas.Create;
Canvas.Handle := HandleW;
Canvas.Brush.Color := cBlurColorKey;

SetWindowLong(HandleW, GWL_EXSTYLE, GetWindowLong(HandleW, GWL_EXSTYLE) or WS_EX_LAYERED);
fSetLayeredWindowAttributesFunc(HandleW, cBlurColorKey, 0, LWA_COLORKEY);

ZeroMemory(@mgn, SizeOf(mgn));
mgn.cxLeftWidth := -1;
mgn.cxRightWidth := -1;
mgn.cyTopHeight := -1;
mgn.cyBottomHeight := -1;

fDwmExtendFrameIntoClientArea(HandleW, @mgn);
end;
end;

FreeLibrary(hDWMDLL);
end;
end;
end;[/more]


Цитата:

Сконвертить хендл в объект можно с помощью все той же FindControl.

Можно пример использования?
В моем случае, както так?

Код: var
frmCtrl:Tform;
...................
frmCtrl:=FindControl(AHandle);

Gnom3
Сконвертить хендл в объект можно с помощью все той же FindControl.

Цитата:

Не дорос еще я до этого.

Это вы зря. Взяв в помощь надежного проводника типа MM CodeExplorer, вы все сделаете меньше чем за час.

Возник следующий вопрос - возможно-ли локально, для VCL-окна отключить сглаживание шрифтов (Cleartype)? доступ к окну, опять-же, только по хендлу, хендл известен.

Подскажите как преобразовать время time_t в TSystemTime.
Статья от Майкрософт
Сделал так собственно:

function Int32x32To64(const a, b: Integer): Int64;
begin
Result := a * b;
end;

procedure UnixTimeToFileTime(const t: time_t; var pft: TFileTime);
var
ll: Int64;
begin
ll := Int32x32To64(t, 10000000) + 116444736000000000;
pft.dwLowDateTime := DWORD(ll);
pft.dwHighDateTime := ll shr 32;
end;

procedure UnixTimeToSystemTime(const t: time_t; var pst: TSystemTime);
var
pft: TFileTime;
begin
UnixTimeToFileTime(t, pft);
FileTimeToSystemTime(pft, pst);
end;

Имею на входе 2301245 и в результате получаю структуру где время и дата равны 00:00:00 01.01.1970 по вычислениям.

Maks150988
Вот преобразование обычного времени в Unix формат

Код:
function DateToUnixDate(Value:TDateTime):integer;
const
SecPerDay = 86400;
Offset1970 = 25569;
begin
Result := Trunc((Value - Offset1970) * SecPerDay) * 1000;
end;

ShIvADeSt
Блин у меня тип time_t был обозначен как Int64 а нужно было Integer.
Поэтому не работал и код.

procedure DateTimeToSystemTime(const pdt: TDateTime; var pst: TSystemTime);
var
dt: TDateTime;
ft: TFileTime;
begin
dt := (pdt + 109205.0) * 864000000000.0;
ft := TFileTime(Round(dt));
FileTimeToSystemTime(ft, pst);
end;

function FormatTimeDate(t: time_t): AnsiString;
const
UnixDateDelta = 25569;
MinPerDay = 24 * 60;
SecPerDay = 24 * 60 * 60;
var
pdt : TDateTime;
tzi : TTimeZoneInformation;
pst : TSystemTime;
bias : Integer;
dwRet: DWORD;
begin
Result := '';
if (t <> 0) then
begin
pdt := UnixDateDelta + (t / SecPerDay);
bias := 0;
dwRet := GetTimeZoneInformation(tzi);
if (dwRet <> TIME_ZONE_ID_INVALID) then
begin
if (dwRet = TIME_ZONE_ID_STANDARD) then
bias := tzi.Bias + tzi.StandardBias
else
bias := tzi.Bias + tzi.DaylightBias;
end;
pdt := pdt - (bias / MinPerDay);
DateTimeToSystemTime(pdt, pst);
Result := Format('%2.2d.%2.2d.%4.4d %2.2d:%2.2d:%2.2d', [pst.wDay, pst.wMonth, pst.wYear, pst.wHour, pst.wMinute, pst.wSecond]);
end;
end;

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

Вопрос к знающим. Мне нужно определить разницу в TSystemTime. Проблема что откуда то берутся 7 минут и 9 секунд.

function AistTimeToSystemTime(pszTime: AnsiString): TSystemTime;
begin
ZeroMemory(@Result, SizeOf(TSystemTime));
Result.wYear := StrToInt(Copy(pszTime, 1, 4));
Result.wMonth := StrToInt(Copy(pszTime, 6, 2));
Result.wDay := StrToInt(Copy(pszTime, 9, 2));
Result.wHour := StrToInt(Copy(pszTime, 12, 2));
Result.wMinute := StrToInt(Copy(pszTime, 15, 2));
Result.wSecond := StrToInt(Copy(pszTime, 18, 2));
end;

var
pszText: AnsiString;
time1 : TSystemTime;
time2 : TSystemTime;
date1 : TFileTime;
date2 : TFileTime;
df : TFileTime;
st : TSystemTime;
begin
time1 := AistTimeToSystemTime('2011-01-01T16:35:00+04:00');
time2 := AistTimeToSystemTime('2011-01-15T16:35:00+04:00');
SystemTimeToFileTime(time1, date1);
SystemTimeToFileTime(time2, date2);
df.dwHighDateTime := date2.dwHighDateTime - date1.dwHighDateTime;
df.dwLowDateTime := date2.dwLowDateTime - date1.dwLowDateTime;
FileTimeToSystemTime(df, st);
Dec(st.wYear, 1601);
Dec(st.wMonth, 1);
Dec(st.wDay, 1);
pszText := Format('%d ч %d мин %d сек %d дн %d мес %d лет', [st.wHour, st.wMinute, st.wSecond, st.wDay, st.wMonth, st.wYear]);
MessageBox(0, LPCSTR(pszText), nil, MB_OK);
end.

Цитата:

Вопрос к знающим. Мне нужно определить разницу в TSystemTime. Проблема что откуда то берутся 7 минут и 9 секунд.

Попробуй для теста все это перегнать в TDateTime, найти разницу и вывести.

Есть файл, который нужно интерпретировать, есть текстовое описание формата данных, который он использует для хранения. Формат описывает эти данные так:
для каждого параметра какой-либо конкретной секции указывается -
офсет (от начала секции или файла), длина данных (в байтах), тип данных (word, dword, string и т. д.)
Я описал некоторые структуры в соответствии с этими данными.
Как прочитать данные теперь из файла в эти структуры? Использовать обычные методы чтения файла?

DmitryKz

Цитата:

Как прочитать данные теперь из файла в эти структуры? Использовать обычные методы чтения файла?

Да. Только структуры должны быть упакованы.