Переписать функцию C в Delphi

[AndreyD2]

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

 

[jik]

в Delphi пишем:

function getstatus(adr: byte): PAnsiChar; cdecl; external 'my.dll' name '_getstatus';

function HexToInt(c: Char): Integer;
begin
  Result := 0;
  if c in ['0'..'9'] then begin
    Result := Ord(c) - 48;
  end else begin
    if c in ['A'..'F'] then begin
      Result := Ord(c) - Ord('A') + 10;
    end else begin
      if c in ['a'..'f'] then begin
        Result := Ord(c) - Ord('a') + 10;
      end;
    end;
  end;
end;

procedure TForm1.ButtonGetStatusClick(Sender: TObject)
var status: PAnsiChar;
    err: Integer;
    s: String;
begin
  status := getstatus(HexToInt(LabEditAddress.Text));
  err := 0;
  s := '';
  if status[0] = Chr(0) then begin
    err := 1;
  end else begin
    s := 'Status = '+IntToHex(status[0],2)+'h. Par1 '+IntToHex(status[1],2)+'h. Par2 '+IntToHex(status[4],2)+'h.';
  end;
  AddMemoLine('getstatus',s,err);
end;

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

 

[AndreyD2]

Супер, jikб а то мне посоветовали вариант)))

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

 

[AndreyD2]

function get_status(adr: byte): PAnsiChar;
cdecl; external 'sss.dll' name 'get_status';
Procedure UpdateStatusS;
var
    status : PAnsiChar;
    I,stid, num_s,min_cool_get,sec_cool_get : integer;
    status_cool : Char;
    str_id: string;
begin
  I:=1;
  if not Setting.Q_set['uprpk'] then exit;
  Form1.SQLSTATUS.Text := '';
  QQ.q_all2.Close;
  QQ.q_all2.SQL.Text := ' select id,pk,keys from SSS order by name';
  QQ.q_all2.Open;
  QQ.q_all2.First;
  while not QQ.q_all2.Eof do
    begin
      str_id := IntToStr(qq.q_all2['id']);
      If QQ.q_all2['pk'] then
        begin
           status := get_status(HexToInt(QQ.q_all2['keys']));
           if status[0] = Chr(0) then
             begin
               stid := 100;
             end
           else
             begin
              stid := Ord(status[0]);
             end;
          case stid of
            100 : Form1.SQLSTATUS.Lines.Add('select ''Ошибка связи'' as st,'+str_id+' as id ');
            112 : Form1.SQLSTATUS.Lines.Add('select ''Свободен'' as st,'+str_id+' as id ');
            117 : Form1.SQLSTATUS.Lines.Add('select ''START'' as st,'+str_id+' as id ');
            else
              Form1.SQLSTATUS.Lines.Add('select ''Error'' as st,'+str_id+' as id ');
          end;
        end
      else
        begin
          Form1.SQLSTATUS.Lines.Add('select ''---'' as st,'+str_id+' as id ');
        end;
      If I <> QQ.q_all2.RecordCount then
        Form1.SQLSTATUS.Lines.Add('union all' );
      I:=I+1;
      QQ.q_all2.Next;
    end;
     QQ.Q_statussol.close;
     QQ.Q_statussol.SQL.Text := Form1.SQLSTATUS.Text;
     QQ.Q_statussol.Open;
end;

Ошибка при выходе с процедуры
При чем ошибка возникает когда число записей в QQ.q_all2 больше 3
Помогите найти ошибку :bc:

 

[jik]

1) Какую версию delphi используешь? Чем компилировалась dll - С++ билдером?

2) Поставь точку останова на строку:

status := get_status(HexToInt(QQ.q_all2['keys']));

3) Остановись на этой точке. Нажми Ctrl+Alt+C, попадешь в ассемблерный код. Выложи скрин (установи тек.строку посередине экрана, чтобы был виден код до вызова функции и после).

4) Нажми f7, чтобы зайти внутрь функции. Нажимай на f8, пока не дойдешь до команды ret. Остановись на этой команде, не нажимая на ней f8. Выложи скрин этого места.

 

[AndreyD2]

1. Delphi7, не знаю скорее всего C++ не билдер
Skin - Первоначальный скрин на входе в процедуру
Skin2 - на ее выполнении ошибка skin3
Skin4 - системный код после ошибки
Посмотреть вложение skrin.rar

Выполняется код после ошибки и на call ntdll. ... возвращается на skin4 и все повторяется до бесконечности


тестовый проект с одной кнопкой при вызове функтии 3 раза ошибки нет при 4 ошибка Посмотреть вложение TEST.rar

 

[jik]

замени cdecl на stdcall:

function get_status(adr: byte): PAnsiChar;
stdcall; external 'sss.dll' name 'get_status';