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

Тема в разделе "Другие языки", создана пользователем AndreyD2, 30 янв 2010.

Статус темы:
Закрыта.
Модераторы: Цукер
  1. AndreyD2

    AndreyD2

    Регистр.:
    21 окт 2008
    Сообщения:
    194
    Симпатии:
    67
    Есть dll в ней функция:
    extern "C" unsigned char * DLL_EXP __stdcall getstatus(char adr);
    В приложении на С вызывается:
    Код:
    void __fastcall TForm1::ButtonGetStatusClick(TObject *Sender)
    {
      unsigned char * status = getstatus(HexToInt(this->LabEditAddress->Text));
      int err = 0;
      String s = "";
      if (status[0]==0) { err = 1;}
      else {
        s = "Status = "+ IntToHex(status[0],2)+"h. Par1 "+IntToHex(status[1],2)+"h. Par2 "+IntToHex(status[4],2) + "h.";
      }
      AddMemoLine("getstatus",s,err);
    }   
    
    LabEditAddress->Text - это текст hex числа, например 49
    Описание функции:Возвращает указатель на массив из шести элементов типа char (8 бит)
    getstatus(char adr)
    вход char adr – адрес от 1 до 7Fh
    выход unsigned char * status
    status [0] – статус.
    status[1] – параметр1
    status[2] – параметр2
    status[4] – параметр3.
    Как реализовать этот код в делфи и считать параметры?:bc:
     
  2. jik

    jik

    Регистр.:
    11 мар 2009
    Сообщения:
    243
    Симпатии:
    133
    в 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 нравится это.
  3. AndreyD2

    AndreyD2

    Регистр.:
    21 окт 2008
    Сообщения:
    194
    Симпатии:
    67
    Супер, jikб а то мне посоветовали вариант)))

    function getstatus(adr: integer:( pointer;
    stdcall; external 'my.dll';

    var
    pp : pointer;
    x1,x2 : byte;
    s:string;
    begin
    pp:= getstatus(hextoint('41'));
    asm
    push eax;
    push ebx;
    mov eax,pp
    mov bl, [eax];
    mov x1, bl;
    mov bh, [eax+2];
    mov x2, bh;
    pop ebx;
    pop eax;
    end;

    ShowMessage(inttostr(x1)+' '+inttostr(x2));
     
  4. AndreyD2

    AndreyD2

    Регистр.:
    21 окт 2008
    Сообщения:
    194
    Симпатии:
    67
    Код:
    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;
    
    Ошибка при выходе с процедуры error.JPG
    При чем ошибка возникает когда число записей в QQ.q_all2 больше 3
    Помогите найти ошибку :bc:
     
  5. jik

    jik

    Регистр.:
    11 мар 2009
    Сообщения:
    243
    Симпатии:
    133
    1) Какую версию delphi используешь? Чем компилировалась dll - С++ билдером?

    2) Поставь точку останова на строку:
    Код:
    status := get_status(HexToInt(QQ.q_all2['keys']));
    3) Остановись на этой точке. Нажми Ctrl+Alt+C, попадешь в ассемблерный код. Выложи скрин (установи тек.строку посередине экрана, чтобы был виден код до вызова функции и после).

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

    AndreyD2

    Регистр.:
    21 окт 2008
    Сообщения:
    194
    Симпатии:
    67
    1. Delphi7, не знаю скорее всего C++ не билдер
    Skin - Первоначальный скрин на входе в процедуру
    Skin2 - на ее выполнении ошибка skin3
    Skin4 - системный код после ошибки
    Посмотреть вложение skrin.rar
    skin5.JPG
    Выполняется код после ошибки и на call ntdll. ... возвращается на skin4 и все повторяется до бесконечности


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

    jik

    Регистр.:
    11 мар 2009
    Сообщения:
    243
    Симпатии:
    133
    замени cdecl на stdcall:

    Код:
    function get_status(adr: byte): PAnsiChar;
    stdcall; external 'sss.dll' name 'get_status';
     
    AndreyD2 нравится это.
Статус темы:
Закрыта.