unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, LibUSB, ComCtrls, Math, ExtCtrls, Buttons;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button4: TButton;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    ListBox1: TListBox;
    StatusBar1: TStatusBar;
    Button2: TButton;
    E0: TEdit;
    E1: TEdit;
    E2: TEdit;
    E3: TEdit;
    E4: TEdit;
    ELen: TEdit;
    E7: TEdit;
    E6: TEdit;
    E5: TEdit;
    Label4: TLabel;
    Label5: TLabel;
    Button3: TButton;
    Edit5: TEdit;
    Edit4: TEdit;
    Label6: TLabel;
    Label7: TLabel;
    Button5: TButton;
    Edit6: TEdit;
    Label8: TLabel;
    CheckBox1: TCheckBox;
    SpeedButton1: TSpeedButton;
    Shape1: TShape;
    Label9: TLabel;
    Timer1: TTimer;
    Label10: TLabel;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    SpeedButton2: TSpeedButton;
    Shape2: TShape;
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Edit5Change(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
  private
    { Private declarations }
  public
    devname: string;
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

type
 TPString = array [0..255] of Char;

const
USBDEV_SHARED_VENDOR  =  $16C0;  (* VOTI *)
USBDEV_SHARED_PRODUCT =  $05DC;  (* Obdev's free shared PID *)
(* Use obdev's generic shared VID/PID pair and follow the rules outlined
 * in firmware/usbdrv/USBID-License.txt.
 *)

(* Command declarations *)
PSCMD_ECHO = 0;
PSCMD_GET  = 1;
PSCMD_ON   = 2;
PSCMD_OFF  = 3;
DDS_TEST   = 4;


{$R *.dfm}



procedure usb_showinfo;

  procedure print_endpoint(endpoint: usb_endpoint_descriptor);
  begin
    Form1.ListBox1.AddItem('      bEndpointAddress: '+ IntToHex(endpoint.bEndpointAddress,2)+ 'h',nil);
    Form1.ListBox1.AddItem('      bEndpointAddress: '+ IntToHex(endpoint.bEndpointAddress,2)+ 'h',nil);
    Form1.ListBox1.AddItem('      bmAttributes:     '+ IntToHex(endpoint.bmAttributes, 2)+ 'h',nil);
    Form1.ListBox1.AddItem('      wMaxPacketSize:   '+ IntToStr(endpoint.wMaxPacketSize),nil);
    Form1.ListBox1.AddItem('      bInterval:        '+ IntToStr(Cardinal(endpoint.bInterval)),nil);
    Form1.ListBox1.AddItem('      bRefresh:         '+ IntToStr(Cardinal(endpoint.bRefresh)),nil);
    Form1.ListBox1.AddItem('      bSynchAddress:    '+ IntToStr(Cardinal(endpoint.bSynchAddress)),nil);
  end;

  procedure print_altsetting(iinterface: usb_interface_descriptor);
  var
    I: integer;
  begin
    Form1.ListBox1.AddItem('    bInterfaceNumber:   '+ IntToStr(Cardinal(iinterface.bInterfaceNumber)),nil);
    Form1.ListBox1.AddItem('    bAlternateSetting:  '+ IntToStr(Cardinal(iinterface.bAlternateSetting)),nil);
    Form1.ListBox1.AddItem('    bNumEndpoints:      '+ IntToStr(Cardinal(iinterface.bNumEndpoints)),nil);
    Form1.ListBox1.AddItem('    bInterfaceClass:    '+ IntToStr(Cardinal(iinterface.bInterfaceClass)),nil);
    Form1.ListBox1.AddItem('    bInterfaceSubClass: '+ IntToStr(Cardinal(iinterface.bInterfaceSubClass)),nil);
    Form1.ListBox1.AddItem('    bInterfaceProtocol: '+ IntToStr(Cardinal(iinterface.bInterfaceProtocol)),nil);
    Form1.ListBox1.AddItem('    iInterface:         '+ IntToStr(Cardinal(iinterface.iInterface)),nil);

    for I := 0 to iinterface.bNumEndpoints-1 do
      begin
        print_endpoint(iinterface.endpoint[I]);
      end;
  end;

  procedure print_interface(iinterface: usb_interface);
  var
    I: integer;
  begin
    for I := 0 to iinterface.num_altsetting-1 do
      begin
        print_altsetting(iinterface.altsetting[I]);
      end;
  end;

  procedure print_configuration(config: usb_config_descriptor);
  var
    I: integer;
  begin
    Form1.ListBox1.AddItem('  wTotalLength:         '+ inttostr(config.wTotalLength),nil);
    Form1.ListBox1.AddItem('  bNumInterfaces:       '+ inttostr(cardinal(config.bNumInterfaces)),nil);
    Form1.ListBox1.AddItem('  bConfigurationValue:  '+ inttostr(cardinal(config.bConfigurationValue)),nil);
    Form1.ListBox1.AddItem('  iConfiguration:       '+ inttostr(cardinal(config.iConfiguration)),nil);
    Form1.ListBox1.AddItem('  bmAttributes:         '+ IntToHex(config.bmAttributes, 2)+ 'h',nil);
    Form1.ListBox1.AddItem('  MaxPower:             '+ inttostr(cardinal(config.MaxPower)),nil);

  for I := 0 to config.bNumInterfaces-1 do
    begin
      print_interface(config.iinterface[I]);
    end;
  end;

var
  bus: pusb_bus;
  dev: pusb_device;
  udev: pusb_dev_handle;
  ret,
  I: integer;
  S: array [0..255] of char;
begin
  usb_init; // Initialize libusb


  usb_find_busses; // Finds all USB busses on system
  usb_find_devices; // Find all devices on all USB devices
  bus := usb_get_busses; // Return the list of USB busses found
  Form1.ListBox1.AddItem('bus/device  idVendor/idProduct',nil);
  while Assigned(bus) do
    begin
      dev := bus^.devices;
      while Assigned(dev) do
        begin
          Form1.ListBox1.AddItem(
                  string(bus^.dirname)+ '/'+string( dev^.filename)+
                  '     '+
                  '0x' + IntToHex(dev^.descriptor.idVendor, 4)+
                  '/'+
                  '0x' + IntToHex(dev^.descriptor.idProduct, 4),nil);


          udev := usb_open(dev);
          if Assigned(udev) then
            begin
              if dev^.descriptor.iManufacturer > 0 then
                begin
                  ret := usb_get_string_simple(udev, dev^.descriptor.iManufacturer, S, sizeof(S));
                  if (ret > 0) then
                    begin
                      Form1.ListBox1.AddItem('- Manufacturer : '+ S,nil);
                    end
                    else
                    begin
                      Form1.ListBox1.AddItem('- Unable to fetch manufacturer string',nil);
                    end;
                end;

              if (dev^.descriptor.iProduct > 0) then
                begin
                  ret := usb_get_string_simple(udev, dev^.descriptor.iProduct, S, sizeof(S));
                  if (ret > 0) then
                    begin
                      Form1.ListBox1.AddItem('- Product      : '+ S,nil);
                    end
                    else
                    begin
                      Form1.ListBox1.AddItem('- Unable to fetch product string',nil);
                    end;
                end;

              if (dev^.descriptor.iSerialNumber > 0) then
                begin
                  ret := usb_get_string_simple(udev, dev^.descriptor.iSerialNumber, S, sizeof(S));
                  if (ret > 0) then
                    begin
                      Form1.ListBox1.AddItem('- Serial Number: '+ S,nil);
                    end
                    else
                    begin
                      Form1.ListBox1.AddItem('- Unable to fetch serial number string',nil);
                    end;
                end;

              usb_close(udev);
            end;

          if not assigned(dev^.config) then
            begin
              Form1.ListBox1.AddItem('  Couldn''t retrieve descriptors',nil);
              continue;
            end;

          for I := 0 to dev^.descriptor.bNumConfigurations-1 do
            begin
              print_configuration(dev^.config[i]);
            end;

          dev := dev^.next;
        end;

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

//////////////////////////////////////////////////////////////

function usbGetStringAscii(handle: pusb_dev_handle; index: Integer;langid: Integer;var buf: TPString;buflen: Integer ): integer;
var
 buffer: array [0..255] of char;
 rval, i: Integer;
begin
    rval := usb_control_msg(handle, USB_ENDPOINT_IN, USB_REQ_GET_DESCRIPTOR, (USB_DT_STRING shl 8) + index, langid, buffer, sizeof(buffer), 1000);
    result:=rval;
    if rval < 0 then exit;
    result:=0;
    if buffer[1] <> char(USB_DT_STRING) then Exit;
    if BYTE(buffer[0]) < rval then
        rval := BYTE(buffer[0]);

    rval:= rval div 2;
    (* lossy conversion to ISO Latin1 *)
    for i := 1 to rval-1 do
      begin
        if i > buflen then  (* destination buffer overflow *)
            break;
        buf[i-1] := buffer[2 * i];
        if buffer[2 * i + 1] <> #0 then (* outside of ISO Latin1 range *)
            buf[i-1] := char('?');
      end;
    buf[i-1] := #0;
    Result := i-1;
end;

(* DDS uses the free shared default VID/PID. If you want to see an
 * example device lookup where an individually reserved PID is used, see our
 * RemoteSensor reference implementation.
 *)

const
  USB_ERROR_NOTFOUND = 1;
  USB_ERROR_ACCESS   = 2;
  USB_ERROR_IO       = 3;


function usbOpenDevice(var device: Pusb_dev_handle; vendor: Integer; vendorName: pchar ;product: Integer; productName: pchar):  Integer;
const
{$J+}
   didUsbInit: integer = 0; //not a true constant but a static variable
{$J-}
var
  bus: Pusb_bus;
  dev: Pusb_device;
  handle: Pusb_dev_handle;
  errorCode: integer;
  S: TPstring;
  len: Integer;
begin
handle:=nil;
errorCode := USB_ERROR_NOTFOUND;
    if didUsbInit=0 then
      begin
        didUsbInit := 1;
        usb_init;
      end;
    usb_find_busses;
    usb_find_devices;
    bus := usb_get_busses;
    While assigned(bus) do
      begin
        dev := bus^.devices;
        while assigned(dev) do
          begin
            if(dev.descriptor.idVendor = vendor) and (dev.descriptor.idProduct = product) then
              begin
                handle := usb_open(dev); (* we need to open the device in order to query strings *)
                if not assigned(handle) then
                  begin
                    errorCode := USB_ERROR_ACCESS;
                    raise Exception.Create('Warning: cannot open USB device '+usb_strerror());
                    continue;
                  end;
                if (vendorName = nil) and (productName = nil) then break; (* name does not matter *)
                (* now check whether the names match: *)
                len := usbGetStringAscii(handle, dev.descriptor.iManufacturer, $0409,S, sizeof(S));
                if (len < 0) then
                  begin
                    errorCode := USB_ERROR_IO;
                    raise Exception.Create('Warning: cannot query manufacturer for device: '+usb_strerror());
                  end
                 else
                  begin
                    errorCode := USB_ERROR_NOTFOUND;
                    (* fprintf(stderr, "seen device from vendor ->%s<-\n", string); *)
                    if StrPas(S)=vendorName then
                      begin
                        len := usbGetStringAscii(handle, dev.descriptor.iProduct, $0409,S, sizeof(S));
                        if (len < 0) then
                          begin
                            errorCode := USB_ERROR_IO;
                            raise Exception.Create('Warning: cannot query product for device: '+usb_strerror());
                          end
                         else
                          begin
                            errorCode := USB_ERROR_NOTFOUND;
                            (* fprintf(stderr, "seen product ->%s<-\n", string); *)
                            if StrPas(S)=productName then
                                break;
                          end;  //if len
                      end; //if string_
                  end;  //if len<0
                usb_close(handle);
                handle := nil;
              end;  //if dev descriptor
            dev := dev.next;
          end;  //while assigned(dev)
        if handle<>nil then break;
        bus := bus.next;
      end;  //while assigned(bus)
    if (handle <> nil) then
      begin
        errorCode := 0;
        device := handle;
      end;
Result := errorCode;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Clear;
usb_showinfo;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
begin
buffer[0]:=#0;
buffer[1]:=#0;
buffer[2]:=#0;
request:=strtoint('$'+Edit1.Text);
value:=strtoint('$'+edit2.Text);
index:=strtoint('$'+edit3.Text);
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);
usb_close(handle);
retval:='';
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Label3.Caption:='USB transfer return value = ';
E0.Text:='02';
E1.Text:='00';
E2.Text:='00';
E3.Text:='00';
E4.Text:='00';
E5.Text:='00';
E6.Text:='00';
E7.Text:='00';
Elen.Text:='01';
devname:= Edit5.Text;
end;

procedure TForm1.Button2Click(Sender: TObject);
var
  handle: Pusb_dev_handle;
  buffer: array[0..7] of char;
  request, value, index,len: integer;
begin
buffer[0]:=char(strtoint('$'+E0.Text));
buffer[1]:=char(strtoint('$'+E1.Text));
buffer[2]:=char(strtoint('$'+E2.Text));
buffer[3]:=char(strtoint('$'+E3.Text));
buffer[4]:=char(strtoint('$'+E4.Text));
buffer[5]:=char(strtoint('$'+E5.Text));
buffer[6]:=char(strtoint('$'+E6.Text));
buffer[7]:=char(strtoint('$'+E7.Text));
len:=strtoint('$'+Elen.Text);
request:=strtoint('$'+Edit1.Text);
value:=strtoint('$'+edit2.Text);
index:=strtoint('$'+edit3.Text);
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT, pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_OUT, request, value, index, buffer, len, 5000);
usb_close(handle);
Label3.Caption:='USB transfer return value = '+inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1]),2)+' Hex';
end;

procedure TForm1.Button3Click(Sender: TObject);
const
  _HS_DIV: array[0..7] of integer=(4,5,6,7,-1,9,-1,11);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
  RFREQ_int: integer;
  RFREQ_frac: integer;
  _RFREQ_frac: array[0..3] of char absolute RFREQ_frac;
  RFREQ: double;
  N1, HS_DIV: integer;
  nN1: integer;
  fout: double;
begin
buffer[0]:=#0;
buffer[1]:=#0;
buffer[2]:=#0;
buffer[3]:=#0;
buffer[4]:=#0;
buffer[5]:=#0;
request:=$3f;
value:=strtoint('$'+edit4.Text);
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);
usb_close(handle);
retval:='';
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';
ListBox1.Clear;
for i:=0 to 5 do
  ListBox1.AddItem('Register '+inttostr(i+7)+' = '+
          inttohex(integer(buffer[i]),2)+' Hex',nil);
ListBox1.AddItem('----------------------------',nil);
RFREQ_int:=0;
RFREQ_frac:=0;
_RFREQ_frac[0]:=buffer[5];
_RFREQ_frac[1]:=buffer[4];
_RFREQ_frac[2]:=buffer[3];
_RFREQ_frac[3]:=char(integer(buffer[2]) and $f);
RFREQ_int:=integer(buffer[2]) div 16
           +(integer(buffer[1]) and $3f)*16;
RFREQ:=RFREQ_int+RFREQ_frac/power(2,28);
ListBox1.AddItem('RFREQ   = '+floattostr(RFREQ),nil);
N1:=integer(buffer[1]) div 64
           +(integer(buffer[0]) and $1f)*4;
ListBox1.AddItem('N1      = '+Inttostr(N1),nil);
nN1:=N1+1;
ListBox1.AddItem('nN1     = '+Inttostr(nN1),nil);
HS_DIV:=integer(buffer[0]) div 32;
ListBox1.AddItem('HS_DIV  = '+Inttostr(HS_DIV),nil);
ListBox1.AddItem('nHS_DIV = '+Inttostr(_HS_DIV[HS_DIV]),nil);
fout:=114.285*RFREQ/(nN1* _HS_DIV[HS_DIV]);
ListBox1.AddItem('frequency = '+floattostr(fout)+' MHz',nil);
end;

procedure TForm1.Edit5Change(Sender: TObject);
begin
devname:=Edit5.Text;
end;

procedure TForm1.Button5Click(Sender: TObject);
const
  fcryst=114.285;
  fLo=4850;
  fHi=5670;
  _HS_DIV: array[0..7] of integer=(4,5,6,7,-1,9,-1,11);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index,len: integer;
  N1, HS_DIV: integer;
  RFREQ: double;
  RFREQ_frac: integer;
  RFREQ_int: integer;
  _RFREQ_frac: array[0..3] of char absolute RFREQ_frac;
  _RFREQ_int: array[0..3] of char absolute RFREQ_int;
  f: double;
  i: integer;
/////////////////////////////////////////////
  function calcDividers(f:double): boolean;
  type
    TSolution=record
      HS_DIV: integer;
      N1: integer;
      f0: double;
      end;
  var
    i: integer;
    imin: integer;
    y: double;
    Sols: array[0..7] of TSolution;
    fmin: double;
  begin
    Result:=true;
    for i:=high(_HS_DIV) downto Low(_HS_DIV) do
     if _HS_DIV[i]>0 then
      begin
       Sols[i].HS_DIV:=i;
       y:=(fHi+fLo)/2/f;         //calculate total divider ratio
       y:=y/_HS_DIV[i];  //calculate N1 ratio
       if y<1.5 then y:=1 else y:=2*round(y/2);
       if y>power(2,7) then y:=power(2,7);
       Sols[i].N1:=trunc(y)-1;
       Sols[i].f0:=f*y*_HS_DIV[i];
      end
     else
       Sols[i].f0:=1e100;
    imin:=-1;
    fmin:=1e100;
    for i:=Low(Sols) to High(Sols) do
      begin
        if (Sols[i].f0>=fLo) and (Sols[i].f0<=fHi) then
          if Sols[i].f0<fmin then
            begin
              fmin:=Sols[i].f0;
              imin:=i;
            end;
      end;
    if imin>=0 then
      begin
        HS_DIV:=Sols[imin].HS_DIV;
        N1:=Sols[imin].N1;
        RFREQ:=Sols[imin].f0/fcryst;
      end
      else Result:=false;
  end;
/////////////////////////////////////////////
begin
f:=StrToFloat(Edit6.Text);
if not calcDividers(f) then
  begin
    ListBox1.Clear;
    ListBox1.AddItem('frequency not supported within spec',nil);
    exit;
  end;
RFREQ_int:=trunc(RFREQ);
RFREQ_frac:=round(frac(RFREQ)*power(2,28));
buffer[5]:=_RFREQ_frac[0];
buffer[4]:=_RFREQ_frac[1];
buffer[3]:=_RFREQ_frac[2];
buffer[2]:=_RFREQ_frac[3];
buffer[2]:=char(BYTE(buffer[2]) or (BYTE(_RFREQ_int[0]) and $f) shl 4);
buffer[1]:=char(RFREQ_int div 16);
buffer[1]:=char(BYTE(buffer[1]) + ((N1 and 3)shl 6));
buffer[0]:=char(N1 div 4);
buffer[0]:=char(BYTE(buffer[0]) +  (HS_DIV shl 5));
////////////////////////////////////////////////////
ListBox1.Clear;
for i:=0 to 5 do
  ListBox1.AddItem('Register '+inttostr(i+7)+' = '+
          inttohex(integer(buffer[i]),2)+' Hex',nil);
ListBox1.AddItem('----------------------------',nil);
ListBox1.AddItem('RFREQ   = '+floattostr(RFREQ),nil);
ListBox1.AddItem('N1      = '+Inttostr(N1),nil);
ListBox1.AddItem('HS_DIV  = '+Inttostr(HS_DIV),nil);
////////////////////////////////////////////////////
len:=length(buffer);
request:=$30;
value:=$700+strtoint('$'+Edit4.Text);
index:=0;
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT, pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_OUT, request, value, index, buffer, len, 5000);
usb_close(handle);
Label3.Caption:='USB transfer return value = '+inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1]),2)+' Hex';
end;

procedure TForm1.CheckBox1Click(Sender: TObject);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
begin
buffer[0]:=#0;
buffer[1]:=#0;
buffer[2]:=#0;
request:=$50;
value:=integer(CheckBox1.Checked);
index:=0;
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);
usb_close(handle);
retval:='';
index:=integer(buffer[0]);
if (index and $2)=$2 then Shape1.Brush.Color:=clLime
                  else Shape1.Brush.Color:=clRed;
if (index and $20)=$20 then Shape2.Brush.Color:=clLime
                  else Shape2.Brush.Color:=clRed;
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';
end;

var
usbhandle: Pusb_dev_handle;

procedure TForm1.SpeedButton1Click(Sender: TObject);
var
//  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
begin
if SpeedButton1.Down then
  begin
    usb_init();
    if (usbOpenDevice(usbhandle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
      begin
        raise Exception.Create(Format(
           'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
              [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
            exit;
        end;
    SpeedButton1.Caption:='stop querying';
    Timer1.Enabled:=true;
  end
  else
  begin
    SpeedButton1.Caption:='continuously query cw key';
    Timer1.Enabled:=false;
    usb_close(usbhandle);
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  buffer: array[0..0] of char;
  request, value, index: integer;
begin
request:=$51;
value:=0;
index:=0;
value:=usb_control_msg(usbhandle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0]),2)+' Hex';
index:=integer(buffer[0]);
if (index and $2)=$2 then Shape1.Brush.Color:=clLime
                  else Shape1.Brush.Color:=clRed;
if (index and $20)=$20 then Shape2.Brush.Color:=clLime
                  else Shape2.Brush.Color:=clRed;
StatusBar1.SimpleText:=inttostr(integer(buffer[0]));
Form1.Repaint;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
  handle: Pusb_dev_handle;
  buffer: array[0..3] of char;
  request, value, index,len: integer;
  f: double;
  nf: cardinal absolute buffer;
  i: integer;
begin
f:=StrToFloat(Edit6.Text);
nf:=round(f*power(2,21));
ListBox1.Clear;
len:=length(buffer);
request:=$32;
value:=$700+strtoint('$'+Edit4.Text);
index:=0;
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT, pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_OUT, request, value, index, buffer, len, 5000);
usb_close(handle);
Label3.Caption:='USB transfer return value = '+inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1]),2)+' Hex';
sleep(50);
//Button3Click(self);
end;

procedure TForm1.Button7Click(Sender: TObject);
const
  _HS_DIV: array[0..7] of integer=(4,5,6,7,-1,9,-1,11);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
  RFREQ_int: integer;
  RFREQ_frac: integer;
  _RFREQ_frac: array[0..3] of char absolute RFREQ_frac;
  RFREQ: double;
  N1, HS_DIV: integer;
  nN1: integer;
  fout: double;
begin
buffer[0]:=#0;
buffer[1]:=#0;
buffer[2]:=#0;
buffer[3]:=#0;
buffer[4]:=#0;
buffer[5]:=#0;
request:=$3e;
value:=strtoint('$'+edit4.Text);
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);
usb_close(handle);
retval:='';
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';
ListBox1.Clear;
for i:=0 to 5 do
  ListBox1.AddItem('Register '+inttostr(i+7)+' = '+
          inttohex(integer(buffer[i]),2)+' Hex',nil);
ListBox1.AddItem('----------------------------',nil);
RFREQ_int:=0;
RFREQ_frac:=0;
_RFREQ_frac[0]:=buffer[5];
_RFREQ_frac[1]:=buffer[4];
_RFREQ_frac[2]:=buffer[3];
_RFREQ_frac[3]:=char(integer(buffer[2]) and $f);
RFREQ_int:=integer(buffer[2]) div 16
           +(integer(buffer[1]) and $3f)*16;
RFREQ:=RFREQ_int+RFREQ_frac/power(2,28);
ListBox1.AddItem('RFREQ   = '+floattostr(RFREQ),nil);
N1:=integer(buffer[1]) div 64
           +(integer(buffer[0]) and $1f)*4;
ListBox1.AddItem('N1      = '+Inttostr(N1),nil);
nN1:=N1+1;
ListBox1.AddItem('nN1     = '+Inttostr(nN1),nil);
HS_DIV:=integer(buffer[0]) div 32;
ListBox1.AddItem('HS_DIV  = '+Inttostr(HS_DIV),nil);
ListBox1.AddItem('nHS_DIV = '+Inttostr(_HS_DIV[HS_DIV]),nil);
fout:=114.285*RFREQ/(nN1* _HS_DIV[HS_DIV]);
ListBox1.AddItem('frequency = '+floattostr(fout)+' MHz',nil);
end;


procedure TForm1.Button8Click(Sender: TObject);
const
  _HS_DIV: array[0..7] of integer=(4,5,6,7,-1,9,-1,11);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
  RFREQ_int: integer;
  RFREQ_frac: integer;
  _RFREQ_frac: array[0..3] of char absolute RFREQ_frac;
  RFREQ: double;
  N1, HS_DIV: integer;
  nN1: integer;
  fout: double;
  fint: integer absolute buffer;
begin
buffer[0]:=#0;
buffer[1]:=#0;
buffer[2]:=#0;
buffer[3]:=#0;
buffer[4]:=#0;
buffer[5]:=#0;
request:=$3f;
value:=strtoint('$'+edit4.Text);
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);

retval:='';
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';
ListBox1.Clear;
RFREQ_int:=0;
RFREQ_frac:=0;
_RFREQ_frac[0]:=buffer[5];
_RFREQ_frac[1]:=buffer[4];
_RFREQ_frac[2]:=buffer[3];
_RFREQ_frac[3]:=char(integer(buffer[2]) and $f);
RFREQ_int:=integer(buffer[2]) div 16
           +(integer(buffer[1]) and $3f)*16;
RFREQ:=RFREQ_int+RFREQ_frac/power(2,28);
N1:=integer(buffer[1]) div 64
           +(integer(buffer[0]) and $1f)*4;
nN1:=N1+1;
HS_DIV:=integer(buffer[0]) div 32;
fout:=114.285*RFREQ/(nN1* _HS_DIV[HS_DIV]);
ListBox1.AddItem('frequency read = '+floattostr(fout)+' MHz',nil);
ListBox1.AddItem('actual frequency = '+Edit6.Text+' MHz',nil);
fout:=1/(fout/strtofloat(Edit6.Text))*114.285;
ListBox1.AddItem('calculated crystal frequency = '
   +floattostr(fout)+' MHz',nil);
fint:=round(fout*power(2,24));
request:=$33;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_OUT, request, value, index, buffer, 4, 5000);

retval:='';
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';


usb_close(handle);
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
  handle: Pusb_dev_handle;
  buffer: array[0..5] of char;
  request, value, index: integer;
  retval: string;
  i: integer;
begin
if speedbutton2.down then
  begin
    speedbutton2.Caption:='startup f = last f';
    value:=strtoint('$'+Edit4.Text);
  end
  else
  begin
    speedbutton2.Caption:='startup f=factory f';
    value:=255;
  end;
buffer[0]:=#0;
buffer[1]:=#0;
buffer[2]:=#0;
request:=$41;
index:=0;
usb_init();
if (usbOpenDevice(handle, USBDEV_SHARED_VENDOR, 'www.obdev.at', USBDEV_SHARED_PRODUCT,   pchar(devname)) <> 0) then
  begin
    raise Exception.Create(Format(
       'Could not find USB device "'+devname+'" with vid=$%x and pid=$%x !',
          [USBDEV_SHARED_VENDOR, USBDEV_SHARED_PRODUCT]));
        exit;
    end;
value:=usb_control_msg(handle, USB_TYPE_VENDOR or USB_RECIP_DEVICE or USB_ENDPOINT_IN, request, value, index, buffer, sizeof(buffer), 5000);
usb_close(handle);
retval:='';
Label3.Caption:='USB transfer return value = '
                +inttoHex(BYTE(buffer[0])+256*BYTE(buffer[1])+256*256*BYTE(buffer[2]),2)+' Hex';
end;

end.