Einzelnen Beitrag anzeigen

DelphiManiac

Registriert seit: 5. Dez 2005
742 Beiträge
 
#3

Re: DLL-Aufruf verändert lokale Variable

  Alt 23. Jun 2009, 17:25
Also kommt wohl nicht genau auf die Variable an, sondern auf die Adresse auf der da etwas passiert.
Delphi-Quellcode:

procedure TForm1.Button1Click(Sender: TObject);
var
  eineVar:string;
 laenge:integer;
//device:pusb_device;
//messageVal:array [0..1]of byte ;
//answerVal: array[0..10] of byte;

buffer: packed array [0..1024] of char;
//res: PChar;//array[0..10] of char;
//zeiger :res;
aFan:RecFans;
aString:string;
sizeOfFan:Word;
  I: Integer;
begin

  // Hier wird laenge definiert //
  laenge := 11;
  sizeOfFan:= SizeOf(aFan);

  // in RTC_open_ID werden die DLL Funktionen aufgerufen
  RTC_open_id(VENDORID,PRODUCTID);
  // Hier stimmt laenge nicht mehr //
  ShowMessage('Länge: '+IntToStr(laenge));

        if usb_handle = Nil then
          begin
            showmessage('can''t open usb device');
            exit;
// result := -1;
          end;
  for I := 0 to 10 do
  begin
    usb_control_msg(usb_handle,UVC_In,7,3,0,buffer[0],11,1000);

  end;




  if usb_control_msg(usb_handle,UVC_In,7,3,0,buffer[0],11,1000) <0 then
  begin
    //se
    if usb_control_msg(usb_handle,UVC_In,7,3,0,buffer[0],11,1000) <0 then
    begin
      showmessage('Fehler control_message'+ usb_strerror());
    end
    else
    begin
      aString:=buffer;
      ShowMessage(aString);
    end;
  end
  else
  begin
      aString:=buffer;
      ShowMessage(aString);
  end;



  if usb_control_msg(usb_handle,UVC_In,2,0,0,aFan,sizeOfFan,1000) <0 then
  begin
    //se
    if usb_control_msg(usb_handle,UVC_In,2,0,0,aFan,SizeOf(aFan),1000) <0 then
    begin
      showmessage('Fehler control_message'+ usb_strerror());
    end
    else
    begin
      aString:=buffer;
// ^aFan:=buffer;
      ShowMessage(IntToStr(aFan.speed));
    end;
  end
  else
  begin
      aString:=buffer;
      ShowMessage(IntToStr(aFan.speed));
  end;

  if usb_control_msg(usb_handle,UVC_Out,3,80,1,buffer[0],0,1000) <0 then
  begin
  end
  else
  begin
      aString:=buffer;
      ShowMessage(IntToStr(aFan.speed));
  end;


end;

Delphi-Quellcode:
function RTC_open_id(vendor: integer; product: integer): integer;
var
  bus: pusb_bus;
  dev: pusb_device;
  noDev:Integer;
begin

  try

    result := 1;

    usb_init;


    if usb_find_busses < 0 then
      showmessage('usb_find_busses() failed');

    noDev := usb_find_devices;
    if noDev < 0 then
    begin
      showmessage('usb_find_devices() failed')
    end
    else
    begin
      ShowMessage('No. of Devices = '+IntToStr(noDev));
    end;

    bus := usb_get_busses;

    if bus = Nil then
      showmessage('usb_get_busses() failed');

    while Assigned(bus) do
    begin
      dev := bus^.devices;
      while Assigned(dev) do
      begin

        if (dev.descriptor.idVendor = VENDORID) and (dev.descriptor.idProduct = PRODUCTID) then
        begin
// showmessage(string(dev.filename) + ' RTC gefunden!');

           usb_handle := usb_open(dev);

          if usb_handle = Nil then
          begin
            showmessage('can''t open usb device');
            result := -1;
          end;

          if usb_set_configuration(usb_handle, dev.config[0].bConfigurationValue) < 0 then
          begin
            showmessage('can''t set configuration for given usb device');
            result := -1;
          end;

          if usb_claim_interface(usb_handle, 0) < 0 then
          begin
            showmessage('can''t claim interface for given usb device');
            result := -1;
          end;
{
          if usb_set_altinterface(usb_handle, 0) < 0 then
          begin
            showmessage('can''t set altinterface for given usb device');
            result := -1;
          end;
}

// ShowMessage(IntToStr(laenge));
          if result = -1 then showmessage('Error: octopus_open_dev');

          exit;
        end;

        dev := dev^.next;
      end;
      bus := bus^.next;
    end;

    if result = -1 then showmessage('could not found octopus device with pid and vid');

  except
    showmessage('Leider ein Fehler');
  end;
end;
  Mit Zitat antworten Zitat