Delphi, Asm, C, WinAPI, PHP, ..., FAQ Опции

[Xplorer]

CODE

S := TFileStream.Create('x.x', fmOpenReadWrite);
S.Size := 123;
S.Free;

[-=CHE@TER=-]

Xplorer!
Ой, спасибо большое!
Что-то я стормозил - думал это свойство только на чтение...

[OffTopic]

Остальные сообщения скрыл, чтобы не позориться... (*улыбается*)

[-=CHE@TER=-]

Ещё пара глупых вопросов:

1. В Си можно сделать такой финт ушами (кусок кода, структура tlist где-нибудь выше объявлена - не суть важно):

CODE

int main(int argc, char *argv[]){
struct tlist *list;
int i;
  list = (struct tlist *)malloc(10*sizeof(list[0])); /* 10 элементов */
  for(i = 0; i<10; i++){
    list[i].par_int = i; /* допустим заполняем как-то поля структуры */
  }
  free(list);
  return(0);
}

Собственно, вопрос тупой - можно ли сделать что-нибудь подобное на Delphi?

CODE

Var T: ^TStruct;
I: Integer;
Begin
  GetMem(T, 10*SizeOf(TStruct));
  For I:=0 To 9 Do
    T^[I].par_int:=I; { вот тут оно ругается, как только не пиши }
  FreeMem(T, 10*SizeOf(TStruct));
End.

Есть ли какой-нибудь способ и чтобы он был не сильно через одно место?..
Заводить ещё один указатель и делать Inc(T2, SizeOf(TStruct)); просьба не предлагать.

2. Второй вопрос такой же. Видел в одной программе примерно такой код:

CODE

Var A,B,C,D: Byte;
...
If (A = Byte('R')) And (B = Byte('I')) And (C = Byte('F')) And (D = Byte('F')) Then

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

CODE

Var dwSign: Cardinal;
...
If dwSign = Cardinal('RIFF') Then { к сожалению, здесь оно ругается}

А то писать $46464952, вместо 'RIFF' не очень наглядно, да и лазить в HEX режим каждый раз, чтобы посмотреть как там сигнатура архива выглядит - лень.

[Grom PE]

-=CHE@TER=-, вопросы нормальные =)

1. Если я правильно понял, то так:

CODE

Type
  PStructArray=^TStructArray;
  TStructArray=array [0..0] of TStruct;
Var
  T: PStructArray;
  I: Integer;
Begin
  GetMem(T, 10*SizeOf(TStruct));
  For I:=0 To 9 Do
    T[I].par_int:=I;
  FreeMem(T, 10*SizeOf(TStruct));
End.

2. Как-то так:

CODE

type T4Char=array [0..3] of char;
var dwSign: cardinal;
begin
  dwSign:=$46464952;
  if T4Char(dwSign) = 'RIFF' then
    WriteLn('yes') else WriteLn('no');
end.

Более оптимизированный код получим при:

CODE

type T4Char=array [0..3] of char;
const RIFF_SIG:T4Char='RIFF';
var dwSign: cardinal;
begin
  dwSign:=$46464952;
  if dwSign = Cardinal(RIFF_SIG) then
    WriteLn('yes') else WriteLn('no');
end.

[-=CHE@TER=-]

Grom PE!
Спасибо большое, только создавать ещё одну структуру - тоже не очень прикольно. Но, хотя бы, от Array of <тип> избавиться можно будет.
Кстати, заменил Write2 на WriteLn в твоём посте, чтобы не вводить в заблуждение тех кто не в курсе. (*улыбается*)

[-=CHE@TER=-]

Небольшая программка для перезапуска зависших приложений.
Замечание:
1) Функции GetModuleFileNameEx() и IsHungAppWindow() есть только в Windows 2000/XP и более новых.
2) GetModuleFileNameEx() - позволяет махом получить имя исполняемого файла процесса - нет нужды заниматься геммороем с CreateToolHelp32Snapshot(), Thread32First/Next(), Module32First/Next() и прочим.
3) GetModuleFileNameEx() есть в юните psapi начиная с Delphi6, но если использовать её через юнит (Uses psapi;), то в код программы добавляется куча всякого шлака (проверка на существование этой функции LoadLibrary() и т.д.), что, я считаю, лишним.
4) GetModuleFileName() есть начиная с Windows 95, но почему-то она возвращает только имя запускаемого приложения, а не того процесса, handle которого ей был передан (глючит?), поэтому и приходится использовать GetModuleFileNameEx().

CODE

Program WHungApp;
Uses Windows;

Function IsHungAppWindow(Wnd: hWnd): BOOL; stdcall; external 'user32.dll' name 'IsHungAppWindow';
Function GetModuleFileNameEx(hProcess: THandle; hModule: HMODULE; lpFilename: PAnsiChar; nSize: DWORD): DWORD; stdcall; external 'psapi.dll' name 'GetModuleFileNameExA';

Function EnumWindowsProc(Wnd: hWnd; lparam: LPARAM): BOOL; stdcall;
Var
    pid: DWORD;
     ph: THandle;
      S: String;
  PInfo: TProcessInformation;
  SInfo: TStartupInfo;
Begin
  If IsHungAppWindow(Wnd) Then
    Begin
      GetWindowThreadProcessId(Wnd, @pid);
      ph:=OpenProcess(PROCESS_ALL_ACCESS, False, pid);
      SetLength(S, MAX_PATH);
      SetLength(S, GetModuleFileNameEx(ph, 0, @S[1], MAX_PATH));
      // terminate process
      TerminateProcess(ph, 0);
      CloseHandle(ph);
      // restart process
      CreateProcess(Nil, PChar(S), Nil, Nil, False, 0, Nil, Nil, SInfo, PInfo);
    End;
  Result:=True;
End;

Begin
  EnumWindows(@EnumWindowsProc, 0);
End.

[-=CHE@TER=-]

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

Добавлено:
Вроде, нашёл.

[-=CHE@TER=-]

Вот код тру перезапускалки:

CODE

Program WHungApp;

Uses Windows;

Function IsHungAppWindow(Wnd: hWnd): BOOL; stdcall; external 'user32.dll' name 'IsHungAppWindow';
Function GetModuleFileNameEx(hProcess: THandle; hModule: HMODULE; lpFilename: PAnsiChar; nSize: DWORD): DWORD; stdcall; external 'psapi.dll' name 'GetModuleFileNameExA';
Function NtQueryInformationProcess(ProcessHandle: THandle; ProcessInformationClass: Byte; ProcessInformation: Pointer; ProcessInformationLength: ULONG; ReturnLength: PULONG): DWORD; stdcall; external 'ntdll.dll' name 'NtQueryInformationProcess';

// Как по PID процесса узнать CMDLINE?, то есть, командную строку?
// http://forum.sources.ru/index.php?showtopic=136611
// http://undocumented.ntinternals.net/

// http://forum.sources.ru/index.php?showtopic=243663
Type

  UNICODE_STRING = Packed Record
    Length       : Word;
    MaximumLength: Word;
    Buffer       : PWideString;
  end;

  PROCESS_BASIC_INFORMATION = Packed Record
    ExitStatus    : DWORD;
    PebBaseAddress: DWORD; // PPEB
    AffinityMask  : DWORD;
    BasePriority  : DWORD;
    uUniqueProcessId: ULong;
    uInheritedFromUniqueProcessId: ULong;
  End;

Function GetProcessCmdLine(hProcess: THandle): String;
Var
       PBI: PROCESS_BASIC_INFORMATION;
    pp, cb: DWORD;
        ws: WideString;
        uz: UNICODE_STRING;
Begin
  Result:='';
  If (NtQueryInformationProcess(hProcess, 0{ProcessBasicInformation},
                               @PBI, SizeOf(PROCESS_BASIC_INFORMATION),
                               @cb) = 0) Then
    Begin
      If ReadProcessMemory(hProcess, Ptr(PBI.PebBaseAddress+16), @pp, 4, cb) Then
        If ReadProcessMemory(hProcess, Ptr(pp+64), @uz, SizeOf(UNICODE_STRING), cb) Then
          Begin
            SetLength(ws, uz.Length Div 2);
            If ReadProcessMemory(hProcess, uz.Buffer, PWideChar(ws), uz.Length, cb) Then
              Result:=AnsiString(ws);
          End;
    End;
End;

Procedure WriteLog(S: String);
Var
    Fl: THandle;
    dw: DWORD;
Begin
  Fl:=CreateFile(PChar(ParamStr(0)+'.log'), GENERIC_WRITE Or GENERIC_READ, 0, Nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  If Fl <> INVALID_HANDLE_VALUE Then
    Begin
      SetFilePointer(Fl, 0, Nil, FILE_END);
      WriteFile(Fl, S[1], Length(S), dw, Nil);
      CloseHandle(Fl);
    End;
End;

Function GetDateTime: String;
Begin
  SetLength(result, 19);
  GetDateFormat(LOCALE_SYSTEM_DEFAULT, 0, Nil, 'yyyy.MM.dd', @result[1], 10);
  GetTimeFormat(LOCALE_SYSTEM_DEFAULT, 0, Nil, 'HH:mm:ss', @result[12], 8);
  result[11]:=#32;
End;

Function EnumWindowsProc(Wnd: hWnd; lparam: LPARAM): BOOL; stdcall;
Var
      pid: DWORD;
       ph: THandle;
     S, C: String;
    PInfo: TProcessInformation;
    SInfo: TStartupInfo;
Begin
  If IsHungAppWindow(Wnd) Then
    Begin
      GetWindowThreadProcessId(Wnd, @pid);
      ph:=OpenProcess(PROCESS_ALL_ACCESS, False, pid);
      If ph<>0 Then
        Begin
          SetLength(S, MAX_PATH);
          SetLength(S, GetModuleFileNameEx(ph, 0, @S[1], MAX_PATH));
          C:=GetProcessCmdLine(ph);
          If Pos('"', C)<>0 Then
            Begin
              C[1]:='_';
              Delete(C, 1, Pos('"', C)+1);
            End
          Else
            Begin
              If Pos('  ', C)<>0 Then
                Delete(C, 1, Pos('  ', C)+1);
            End;
          S:='"'+S+'" '+C;
          WriteLog(GetDateTime+#32+S+#13#10);
          // terminate process
          TerminateProcess(ph, 0);
          CloseHandle(ph);
          // restart process
          FillChar(SInfo, SizeOf(SInfo), 0);
          SInfo.cb:=SizeOf(SInfo);
          CreateProcess(Nil, PChar(S), Nil, Nil, False, 0, Nil, Nil, SInfo, PInfo);
          CloseHandle(PInfo.hThread);
          CloseHandle(PInfo.hProcess);
        End;
    End;
  Result:=True;
End;

Begin
  EnumWindows(@EnumWindowsProc, 0);
End.

[-=CHE@TER=-]

PHP 5.2.1 + IIS 6

PHP has encountered an Access Violation at 0117A242 (может быть другой адрес)
Затем вообще падает IIS и никакой страницы не возвращает ("внутренняя ошибка сервера").
Перезапуск службы IIS помогает, но ненадолго.

Причина: кривая реализация всех независящих от регистра (case-insensitive) функций:
str_ireplace()
strcasecmp()
etc.

Если где-то есть вызов хотя бы одной такой функции - ошибок не будет, но через некоторое время IIS упадёт.

В какой версии PHP это исправили и исправили ли вообще - не знаю.
Возможно, что это косяк только Windows-версии PHP.

[-=CHE@TER=-]

Очередная херня - столько времени убил, пока нагуглил как решается.

Что устанавливалось: Apache 2.2 + PHP 5.2.6 + MySQL 4.1

Во-первых, чтобы встал PHP на Apache 2.2 надо в httpd.conf писать:

PHPIniDir "C:/PHP/"
LoadModule php5_module "C:/PHP/php5apache2_2.dll"

Ну и всякие там ниже по тексту (в IfModule mime_module):

AddType application/x-httpd-php .php

Во, вторых, всё встало, кроме MySQL - через CLI, QueryBrowser работает, через PHP, зараза, не хочет. На странице пишет:

Fatal error: Call to undefined function mysql_connect() in test.php on line ###

При этом в лог Apache (/logs/error.log) бодро пихается:

PHP Warning: PHP Startup: Unable to load dynamic library 'C:\\PHP\\ext\\php_mysql.dll' - Не найдена указанная процедура.\r\n in Unknown on line 0

Русская строчка декодирована из: \xcd\xe5\xed\xe0\xe9\xe4\xe5\xed\xe0 \xf3\xea\xe0\xe7\xe0\xed\xed\xe0\xff xef\xf0\xee\xf6\xe5\xe4\xf3\xf0\xe0.

Оказывается, надо скопировать файл libmysql.dll из C:\PHP\ в C:\Program Files\Apache Software Foundation\Apache2.2\bin\ и перезапустить Apache.

[-=CHE@TER=-]

Есть на форме UpDown1, ассоциированный (Associate) с ним Edit1 и кнопка.

На кнопке такой код:

CODE

Procedure TForm1.Button1Click(Sender: TObject);
Var TI: TINIFile;
Begin
  If OpenDialog1.Execute Then
    Begin
      TI:=TINIFile.Create(OpenDialog1.FileName);
      UpDown1.Position:=TI.ReadInteger('Section', 'Value', 0);
      TI.Free;
    End;
End;

Пашет только если нажать два (!) раза подряд (с открытием файла, конечно). А если написать так:

CODE

      TI:=TINIFile.Create(OpenDialog1.FileName);
      Edit1.Text:=IntToStr(TI.ReadInteger('Section', 'Value', 0));
      TI.Free;

Или даже так:

CODE

      UpDown1.Position:=123;

То Edit1 обновляется вместе с UpDown1 с первого раза. В чём засада кто-нибудь знает? Refresh / Update у Edit1 и UpDown1 (а также вызов OnChanging) не спасли гиганта мысли. Такой код:

CODE

X:=TI.ReadInteger('Section', 'Value', 0);
UpDown1.Position:=X;

На удивление тоже не работает (вернее работает, но со второго раза).

[Grom PE]

-=CHE@TER=-,
у меня с чистым созданным проектом всё работает с первого раза.
Смотри, нет ли у тебя какого-нибудь старого кода, который мешает.
Еще попробуй перезапустить Delphi.

[-=CHE@TER=-]

Еще попробуй перезапустить Delphi.

Как оно всё оказывается просто - перезапустил и прошло. Даже обидно. (*улыбается*)

[-=CHE@TER=-]

Вопрос сложный, но может кто-то знает в чём прикол...
В общем DirectDraw и RTSP-поток.
IBasicVideo.GetCurrentImage - размер изображения 720x576 (и сохраняется оно таким растянутым).
IBasicVideo.GetVideoSize - 720x480.
А на самом деле оно 720x540 - когда в окне просматриваешь.
Кто-нибудь знает отчего такой расколбас и можно ли его запилить?

Для декодирования потока используются кодеки MainConcept GmbH Network Source и SDP Parser Engine версии 7.5.0.35746.

[-=CHE@TER=-]

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

Если поставить на форме обработку событий:

CODE

OnDblClick
OnMouseDown
OnMouseUp

И писать при их возникновении в Memo соответствующие текст, то получим такую последовательность при двойном щелчке на форме:

CODE

MouseDown
MouseUp
DoubleClick
MouseDown
MouseUp

А теперь, внимание! Если в обработчике события OnDblClick делается что-то тяжёлое (какие-нибудь вычисления, работа с COM и т.д.) - то события приходят уже в таком порядке:

CODE

MouseDown
MouseUp
MouseUp
DoubleClick
MouseDown

Т.е. MouseUp приходит раньше MouseDown! Абзац!!! Причём это не глюк Delphi - потому что если вручную перехватывать соответствующие WM_ сообщения - всё будет точно также!
Однако, немного покурив доки по сообщениям решение нашлось:

CODE

type
  TForm1 = class(TForm)
    ...
  private
    procedure WMLButtonDblClk(var Msg: TMessage); message WM_LBUTTONDBLCLK;
    { Private declarations }
  public
    { Public declarations }
  end;

...

Procedure TForm1.WMLButtonDblClk(var Msg: TMessage);
Begin
  // тут делаем что-нибудь
  Msg.Result:=-1; // <-- не пускаем это сообщение дальше!!!
End;

В результате при Msg.Result:=-1 вторую пару сообщений MouseDown и MouseUp система уже не шлёт:

CODE

MouseDown
MouseUp
DoubleClick

[-=CHE@TER=-]

Кто-нибудь знает, как можно проверить сокет на дохлость?
Суть проблемы: создаю подключение к серверу, а он может его закрыть - тогда на команде получения данных Recv() у меня программа навечно впадает в кому.

В Интернете вычитал, что можно попробовать получить 0 байт и проверить ошибку:

CODE

Recv(SK, result[1], 0, 0);
If WSAGetLastError = 0 Then Sz:=Recv(SK, result[1], Sz, 0) Else Sz:=SOCKET_ERROR;

Однако! Первая строчка с получением 0 байт у меня работает нормально (XP SP3), а на соседней машине (2003 SP2) появляется BSoD с DRIVER_IRQL_NOT_LESS_OR_EQUAL. При этом сама машина с 2003 работает нормально и BSoD там никогда не было.

Кто-нибудь может объяснить это вообще как понимать?

Я, конечно, попробую ещё переписать с Select(), но такое поведение меня очень сильно озадачивает...

[Siberian GRemlin]

Обычно указывается драйвер вызвавший эту ошибку. Если он указан -- попробуй его обновить. В сети достаточно много информации по этой теме. Ты пробовал искать?

[-=CHE@TER=-]

Обычно указывается драйвер вызвавший эту ошибку. Если он указан -- попробуй его обновить. В сети достаточно много информации по этой теме. Ты пробовал искать?

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

[Siberian GRemlin]

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

[-=CHE@TER=-]

Однако! Первая строчка с получением 0 байт у меня работает нормально (XP SP3), а на соседней машине (2003 SP2) появляется BSoD с DRIVER_IRQL_NOT_LESS_OR_EQUAL. При этом сама машина с 2003 работает нормально и BSoD там никогда не было.

Как оказалось BSoD был совсем не там...
Короче, перед CloseSocket(), особенно для UDP-соединений нужно делать shutdown(), желательно с SD_BOTH, иначе на некоторых сетевых картах, драйвера к которым писали криворукие имбецилы, очень быстро забивается буфер и случается BSoD (т.к. приложение уже не забирает пакеты из буфера и вообще закрыло сокет, а тупой драйвер всё ещё продолжает их туда пихать).
На сетевых картах, драйвера к которым писали вменяемые люди, при таком раскладе буфер самоочищается и сокет самозакрывается - т.е. сделана жёсткая проверка "на дурака".