Поиск бага в DriveBox-e

Форумы Ошибки в компонентахПоиск бага в DriveBox-e ← Ctrl1 2 345Ctrl →

Этот топик читают: Гость

Ответов: 1841

Рейтинг: 369

#46: 2011-11-17 13:16:32 ЛС | профиль | цитата


    Result := Buf;
    _Debug;// ok
    if (Result <> '') and (DriveType <> DRIVE_REMOVABLE) then
      Result := DisplayName(Drv)
    else
      Result := '<none>';
      _Debug;// ok
  end
   //_Debug; error compile
  else
  _Debug;// runtime error
    Result := DisplayName(Drv);

ошибка=рантайм

карма: 1

Альтернативная сборка HiAsm 4.

Разработчик

Ответов: 26061

Рейтинг: 2120

#47: 2011-11-17 13:28:28 ЛС | профиль | цитата

CriDos писал(а):

else
_Debug;// runtime error
Result := DisplayName(Drv);

Так делать нельзя
_debug -- это метод, и методов после else становится уже болше однго, правильно делать вот так


  else
  begin
    _Debug;
    Result := DisplayName(Drv);
  end;

Попробуй еще вот такой код



function GetLabelDisk(Drv: Char; VolReal: Boolean): string;
var  WinVer: Byte;
     DriveType, NotUsed: DWORD;
     Buf: string;
     L: integer;
function DisplayName(Drv: Char): string;
var  SFI: TSHFileInfo;
begin
  FillChar(SFI, SizeOf(SFI), 0);
  SHGetFileInfo(PChar(Drv + ':\'), 0, SFI, SizeOf(SFI), SHGFI_DISPLAYNAME);
  Result := SFI.szDisplayName;
  if Pos('(', Result) <> 0 then
    SetLength(Result, Pos('(', Result) - 2);
end;

begin
  Result := '';
  WinVer := LOBYTE(LOWORD(GetVersion));
  DriveType := GetDriveType(PChar(Drv + ':\'));

  if {(DriveType <> DRIVE_REMOVABLE) or} VolReal then
  begin
    SetLength(Buf, MAX_PATH - 1);
//    Buf[1] := #0;
    GetVolumeInformation(PChar(Drv + ':\'), @Buf[1], MAX_PATH - 1, nil, NotUsed, NotUsed, nil, 0);
    Result := Buf;
    L := Length(Result);
    while (L > 0) and (Result[L] < ' ') do Dec(L);
    SetLength(Result, L);

    if (Result <> '') and (DriveType <> DRIVE_REMOVABLE) then
      Result := DisplayName(Drv)
    else
      Result := '<none>';
  end
  else
    Result := DisplayName(Drv);
end;

карма: 22

Ответов: 1841

Рейтинг: 369

#48: 2011-11-17 13:42:33 ЛС | профиль | цитата


  if {(DriveType <> DRIVE_REMOVABLE) or} VolReal then
  begin
    _Debug;// runtime error
    SetLength(Buf, MAX_PATH - 1);

карма: 1

Альтернативная сборка HiAsm 4.

Разработчик

Ответов: 26061

Рейтинг: 2120

#49: 2011-11-17 13:55:29 ЛС | профиль | цитата

Вот это уже херня какая-то, чтобы булевская переменная VolReal вызывала ошибку...

Ну а тупо убрать ее отслеживание


begin
  Result := '';
  WinVer := LOBYTE(LOWORD(GetVersion));
  DriveType := GetDriveType(PChar(Drv + ':\'));
(*
  if {(DriveType <> DRIVE_REMOVABLE) or} VolReal then
  begin
    SetLength(Buf, MAX_PATH - 1);
    GetVolumeInformation(PChar(Drv + ':\'), @Buf[1], MAX_PATH - 1, nil, NotUsed, NotUsed, nil, 0);
    Result := Buf;
    L := Length(Result);
    while (L > 0) and (Result[L] < ' ') do Dec(L);
    SetLength(Result, L);

    if (Result <> '') and (DriveType <> DRIVE_REMOVABLE) then
      Result := DisplayName(Drv)
    else
      Result := '<none>';
  end
  else
*)  
    Result := DisplayName(Drv);
end;

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

карма: 22

Ответов: 1841

Рейтинг: 369

#50: 2011-11-17 14:20:24 ЛС | профиль | цитата

чего-то я не смог найти в функции DisplayName runtime error...
------------ Дoбавленo в 14.09:
в function THIDriveBox.GetDriveName; дебаг не сработал
------------ Дoбавленo в 14.20:

CriDos писал(а):

в function THIDriveBox.GetDriveName; дебаг не сработал

брешу


procedure THIDriveBox.SetDriveName;
*
    if Err then
      if DriveReady(Control.Items[DrvIdx][3]) then
        Control.CurIndex := DrvIdx
      else
      begin // ??? ???????? ???????? ??????
        _Debug; /здесь рантайм выпадает вместо дебага.
        Drv := #99 + ':';
        Control.CurIndex := Control.SearchFor(Drv[1], 0, True);
      end

карма: 1

Альтернативная сборка HiAsm 4.

Разработчик

Ответов: 26061

Рейтинг: 2120

#51: 2011-11-17 17:40:54 ЛС | профиль | цитата

Че-то я потерялся. Ошибки возникают там, где их не должно быть вообще
------------ Дoбавленo в 15.18:
И какого тебя понесло в SetDriveName

------------ Дoбавленo в 17.40:
CriDos, ну и чего, че-нибудь еще надыбал

карма: 22

Ответов: 1731

Рейтинг: 68

#52: 2011-11-17 18:27:01 ЛС | профиль | цитата

[flood]Что-то у меня компьютер через Ж сделан.
До обновления компонента вылетал рунтайм только ПОСЛЕ выключения программы
После обновления не каких ошибок нет, не на FPC, не на Delphi.[/flood]

карма: 1

Разработчик

Ответов: 26061

Рейтинг: 2120

#53: 2011-11-17 19:02:36 ЛС | профиль | цитата

Cosinus писал(а):

После обновления не каких ошибок нет, не на FPC, не на Delphi.

Какая ревизия обновления

карма: 22

Ответов: 1731

Рейтинг: 68

#54: 2011-11-17 20:20:48 ЛС | профиль | цитата

Без понятия обновлял через среду.
Вот эта схема компилируется без проблем на обоих компиляторах.

Add(MainForm,2953706,203,70){
}
Add(DriveBox,13612168,203,112)
{
 Left=75
 Top=100
 Width=235
 Height=21
}

Win7 SP1 x86 AltBuild 299.1
Под FPC в отладке все идеально.
Под Delphi пару хинтов про WinLayout.pas скажет и все.

карма: 1

Ответов: 1841

Рейтинг: 369

#55: 2011-11-18 09:15:35 ЛС | профиль | цитата

Извините что пропал, буквально оторвали от пк

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

Сейчас немного приберусь, и как только появишься, предоставлю полный доступ к системе (TeamViewer).

карма: 1

Альтернативная сборка HiAsm 4.

Разработчик

Ответов: 26061

Рейтинг: 2120

#56: 2011-11-18 11:32:16 ЛС | профиль | цитата

Исследовани на компьютере CriDos-a показали следующее (перепост с лички)

nesco писал(а):

CriDos, проблема у тебя в среде, а не в компоненте.
Ошибка до первого дебага на вот это


procedure THIDriveBox.Init;
begin
_debug;
  Control := NewCombobox(FParent, [coReadOnly, coOwnerDrawFixed]);
  if ManFlags and $04 > 0 then
  begin
    Control.OnMeasureItem:= OnMeasureItem;
    Control.OnDrawItem := NewOnDrawItem; 
  end
  else
    Control.OnDrawItem := OldOnDrawItem;

  DriveBoxs.Add(Control);
_debug;

говорит о том, что секцияя Init не работает и до оформления класса контрола вообще дело не доходит

------------ Дoбавленo в 11.32:
Ваши предложения, что скажешь, Indigo

карма: 22

Ответов: 1841

Рейтинг: 369

#57: 2011-11-18 11:38:31 ЛС | профиль | цитата

ну что-же, попробую системные библиотеки перебросить в чистую ос и посмотреть...

карма: 1

Альтернативная сборка HiAsm 4.

Разработчик

Ответов: 26061

Рейтинг: 2120

#58: 2011-11-18 11:45:34 ЛС | профиль | цитата

Может тебе свою версию HiAsm-a дать, попробуешь на ней

карма: 22

Ответов: 1841

Рейтинг: 369

#59: 2011-11-18 11:46:50 ЛС | профиль | цитата

чего-то я не понял, а как же?

nesco писал(а):

Попробуй поставить в методе THIDriveBox.UpdateDriveBox ремарку только на
SetDriveName(Drv);

CriDos писал(а):

ошибка пропала

------------ Дoбавленo в 11.46:

nesco писал(а):

Может тебе свою версию HiAsm-a дать, попробуешь на ней

nesco, мне давали даже уже скомпилированный exe с этим элементов, та же ошибка)

карма: 1

Альтернативная сборка HiAsm 4.

Разработчик

Ответов: 26061

Рейтинг: 2120

#60: 2011-11-18 11:48:34 ЛС | профиль | цитата

А вот сейчас дебаг выдает что-то или нет, у меня выдает

------------ Дoбавленo в 11.48:
Тогда посмотрим еще, но канал обмена очень дохлый, тяжело так работать

карма: 22

Форумы Ошибки в компонентахПоиск бага в DriveBox-e ← Ctrl1 2 345Ctrl →


Сообщение ...
Прикрепленные файлы (файлы не залиты)