Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Delphi'de kod yazma ile ilgili sorularınızı bu foruma yazabilirsiniz.
Cevapla
seci20
Üye
Mesajlar: 229
Kayıt: 25 May 2015 04:39

Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen seci20 » 25 Nis 2018 02:30

Ustalarım kolay gelsin. Sony cihazlar için bir program yazıyorum ama usb dosya yazdırma kısmında malasef takıldım. Normal internette olan mah.usb, usb detector,nrlibcomm gibi eklentileri kullandım ama yazmayı bir türlü başaramadım. İnternetteki listeleme yöntemleriyle sadece usb diskleri listelemeyi başardım malasef baya uzun süredir araştırdım ama malasef listeleme işlemini başaramadım. Bu konuda yardımcı olabilirmisiniz.

Kullandığım unitler.

Mahusb.pas

Kod: Tümünü seç

unit MahUSB;

interface

uses
  Windows,
  Messages,
  SysUtils,
  Classes,
  Registry,
  Masks;

type
  { Event Types }
  TOnDevVolumeEvent = procedure(const bInserted : boolean;
                                const sDrive : string) of object;
  TOnUsbChangeEvent = procedure(const bInserted : boolean;
                                const ADevType,ADriverName,
                                      AFriendlyName : string) of object;

  { USB Class }
  TUsbClass = class(TObject)
  private
    FHandle : HWND;
    FOnUsbChangeEvent : TOnUsbChangeEvent;
    FOnDevVolumeEvent : TOnDevVolumeEvent;
    procedure GetUsbInfo(const ADeviceString : string;
                         out ADevType,ADriverDesc,
                            AFriendlyName : string);
    function DriverLetter(const aUM:Cardinal) : string;
    procedure WinMethod(var AMessage : TMessage);
    procedure RegisterUsbHandler;
    procedure WMDeviceChange(var AMessage : TMessage);
  public
    constructor Create;
    destructor Destroy; override;
    property OnUsbChange : TOnUsbChangeEvent read FOnUsbChangeEvent
                                           write FOnUsbChangeEvent;
    property OnDevVolume : TOnDevVolumeEvent read FOnDevVolumeEvent
                                          write FOnDevVolumeEvent;
  end;



// -----------------------------------------------------------------------------
implementation

type
  // Win API Definitions
  PDevBroadcastDeviceInterface  = ^DEV_BROADCAST_DEVICEINTERFACE;
  DEV_BROADCAST_DEVICEINTERFACE = record
    dbcc_size : DWORD;
    dbcc_devicetype : DWORD;
    dbcc_reserved : DWORD;
    dbcc_classguid : TGUID;
    dbcc_name : char;
  end;

  PDEV_BROADCAST_VOLUME = ^DEV_BROADCAST_VOLUME;
  DEV_BROADCAST_VOLUME = record
    dbcv_size : DWORD;
    dbcv_devicetype : DWORD;
    dbcv_reserved : DWORD;
    dbcv_unitmask : DWORD;
    dbcv_flags : WORD;
  end;
{
dbcv_flags ->

DBTF_MEDIA   0x0001
Change affects media in drive. If not set, change affects physical device or drive.

DBTF_NET   0x0002
Indicated logical volume is a network volume.
}



const
{
http://msdn.microsoft.com/en-us/library/aa363431%28VS.85%29.aspx

RegisterDeviceNotification


http://msdn.microsoft.com/en-us/library/aa363246%28VS.85%29.aspx

DBT_DEVTYP_DEVICEINTERFACE   0x00000005
Class of devices. This structure is a DEV_BROADCAST_DEVICEINTERFACE structure.

DBT_DEVTYP_HANDLE   0x00000006
File system handle. This structure is a DEV_BROADCAST_HANDLE structure.

DBT_DEVTYP_OEM   0x00000000
OEM- or IHV-defined device type. This structure is a DEV_BROADCAST_OEM structure.

DBT_DEVTYP_PORT   0x00000003
Port device (serial or parallel). This structure is a DEV_BROADCAST_PORT structure.

DBT_DEVTYP_VOLUME   0x00000002
Logical volume. This structure is a DEV_BROADCAST_VOLUME structure.
}
  // Miscellaneous
  GUID_DEVINTF_USB_DEVICE : TGUID = '{A5DCBF10-6530-11D2-901F-00C04FB951ED}';
  USB_VOLUME                   = $00000002; // Device interface class
  USB_INTERFACE                = $00000005; // Device interface class
  USB_INSERTION                = $8000;     // System detected a new device
  USB_REMOVAL                  = $8004;     // Device is gone
  DBTF_MEDIA =  $0001;
  DBTF_NET   =  $0002;

  // Registry Keys
  USBKEY  = 'SYSTEM\CurrentControlSet\Enum\USB\%s\%s';
  USBSTORKEY = 'SYSTEM\CurrentControlSet\Enum\USBSTOR';
  SUBKEY1  = USBSTORKEY + '\%s';
  SUBKEY2  = SUBKEY1 + '\%s';


constructor TUsbClass.Create;
begin
  inherited Create;
  FHandle := AllocateHWnd(WinMethod);
  RegisterUsbHandler;
end;


destructor TUsbClass.Destroy;
begin
  DeallocateHWnd(FHandle);
  inherited Destroy;
end;


procedure TUsbClass.GetUsbInfo(const ADeviceString : string;
                               out ADevType,ADriverDesc,
                                   AFriendlyName : string);
var sWork,sKey1,sKey2 : string;
    oKeys,oSubKeys : TStringList;
    oReg : TRegistry;
    i,ii : integer;
    bFound : boolean;
begin
  ADevType := '';
  ADriverDesc := '';
  AFriendlyName := '';

  if ADeviceString <> '' then begin
    bFound := false;
    oReg := TRegistry.Create;
    oReg.RootKey := HKEY_LOCAL_MACHINE;

    // Extract the portions of the string we need for registry. eg.
    // \\?\USB#Vid_4146&Pid_d2b5#0005050400044#{a5dcbf10- ..... -54334fb951ed}
    // We need sKey1='Vid_4146&Pid_d2b5' and sKey2='0005050400044'
    sWork := copy(ADeviceString,pos('#',ADeviceString) + 1,1026);
    sKey1 := copy(sWork,1,pos('#',sWork) - 1);
    sWork := copy(sWork,pos('#',sWork) + 1,1026);
    sKey2 := copy(sWork,1,pos('#',sWork) - 1);

    // Get the Device type description from \USB key
    if oReg.OpenKeyReadOnly(Format(USBKEY,[skey1,sKey2])) then begin
      ADevType := oReg.ReadString('DeviceDesc');
      oReg.CloseKey;
      oKeys := TStringList.Create;
      oSubKeys := TStringList.Create;

      // Get list of keys in \USBSTOR and enumerate each key
      // for a key that matches our sKey2='0005050400044'
      // NOTE : The entry we are looking for normally has '&0'
      // appended to it eg. '0005050400044&0'
      if oReg.OpenKeyReadOnly(USBSTORKEY) then begin
        oReg.GetKeyNames(oKeys);
        oReg.CloseKey;

        // Iterate through list to find our sKey2
        for i := 0 to oKeys.Count - 1 do begin
          if oReg.OpenKeyReadOnly(Format(SUBKEY1,[oKeys[i]])) then begin
            oReg.GetKeyNames(oSubKeys);
            oReg.CloseKey;

            for ii := 0 to oSubKeys.Count - 1 do begin
              if MatchesMask(oSubKeys[ii],sKey2 + '*') then begin
                // Got a match?, get the actual desc and friendly name
                if oReg.OpenKeyReadOnly(Format(SUBKEY2,[oKeys[i],
                                        oSubKeys[ii]])) then begin
                  ADriverDesc := oReg.ReadString('DeviceDesc');
                  AFriendlyName := oReg.ReadString('FriendlyName');
                  oReg.CloseKey;
                end;

                bFound := true;
              end;
            end;
          end;

          if bFound then break;
        end;
      end;

      FreeAndNil(oKeys);
      FreeAndNil(oSubKeys);
    end;

    FreeAndNil(oReg);
  end;
end;


procedure TUsbClass.WMDeviceChange(var AMessage : TMessage);
var iDevType : integer;
    sDevString,sDevType,
    sDriverName,sFriendlyName : string;
    pData : PDevBroadcastDeviceInterface;
    pVol : PDEV_BROADCAST_VOLUME;
begin
  if (AMessage.wParam = USB_INSERTION) or
     (AMessage.wParam = USB_REMOVAL) then begin
    pData := PDevBroadcastDeviceInterface(AMessage.LParam);
    iDevType := pData^.dbcc_devicetype;

    if iDevType = USB_VOLUME then
      if Assigned(FOnDevVolumeEvent) then begin
        pVol := PDEV_BROADCAST_VOLUME(AMessage.LParam);
        FOnDevVolumeEvent((AMessage.wParam = USB_INSERTION),
                          DriverLetter(pVol.dbcv_unitmask));
      end
      else
    else
    // Is it a USB Interface Device ?
    if iDevType = USB_INTERFACE then begin
      sDevString := PChar(@pData^.dbcc_name);
      GetUsbInfo(sDevString,sDevType,sDriverName,sFriendlyName);
      // Trigger Events if assigned
      if Assigned(FOnUsbChangeEvent) then
         FOnUsbChangeEvent((AMessage.wParam = USB_INSERTION),
                           sDevType,sDriverName,sFriendlyName);
    end;
  end;
end;



procedure TUsbClass.WinMethod(var AMessage : TMessage);
begin
  if (AMessage.Msg = WM_DEVICECHANGE) then
    WMDeviceChange(AMessage)
  else
    AMessage.Result := DefWindowProc(FHandle,AMessage.Msg,
                                     AMessage.wParam,AMessage.lParam);
end;


procedure TUsbClass.RegisterUsbHandler;
var rDbi : DEV_BROADCAST_DEVICEINTERFACE;
    iSize : integer;
begin
  iSize := SizeOf(DEV_BROADCAST_DEVICEINTERFACE);
  ZeroMemory(@rDbi,iSize);
  rDbi.dbcc_size := iSize;
  rDbi.dbcc_devicetype := USB_INTERFACE;
  rDbi.dbcc_reserved := 0;
  rDbi.dbcc_classguid  := GUID_DEVINTF_USB_DEVICE;
  rDbi.dbcc_name := #0;
  RegisterDeviceNotification(FHandle,@rDbi,DEVICE_NOTIFY_WINDOW_HANDLE);
end;


function TUsbClass.DriverLetter(const aUM: Cardinal): string;
begin
  case aUM of
          1:  result :=  'A:';
          2:  result :=  'B:';
          4:  result :=  'C:';
          8:  result :=  'D:';
         16:  result :=  'E:';
         32:  result :=  'F:';
         64:  result :=  'G:';
        128:  result :=  'H:';
        256:  result :=  'I:';
        512:  result :=  'J:';
       1024:  result :=  'K:';
       2048:  result :=  'L:';
       4096:  result :=  'M:';
       8192:  result :=  'N:';
      16384:  result :=  'O:';
      32768:  result :=  'P:';
      65536:  result :=  'Q:';
     131072:  result :=  'R:';
     262144:  result :=  'S:';
     524288:  result :=  'T:';
    1048576:  result :=  'U:';
    2097152:  result :=  'V:';
    4194304:  result :=  'W:';
    8388608:  result :=  'X:';
   16777216:  result :=  'Y:';
   33554432:  result :=  'Z:';
  end;
end;

end.


Usbdetect.pas

Kod: Tümünü seç

unit USBDetect;

////////////////////////////////////////////////////
///                                              ///
///  USB Detector component     Ver 2.0.0.0      ///
///                                              ///
///  Written by Mojtaba Tajik ( Silversoft )     ///
///  Released on 10/13/2010                      ///
///  E-Mail : Tajik1991@gmail.com                ///
///                                              ///
////////////////////////////////////////////////////

interface

uses
  Windows, Forms, SysUtils, Classes, Messages, dialogs;

type
  TUSBEvent= Procedure (Sender: TObject; Drive: String) of Object;

type
  TUSBDetector = class(TComponent)
  private
    { Private declarations }
    FWindowHandle: HWND;
    FArrival, FRemoved: TUSBEvent;
    procedure WndProc(var Msg: TMessage);
  protected
    { Protected declarations }
    procedure WMDEVICECHANGE(Var Msg: TMessage); Message WM_DEVICECHANGE;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    Property OnArrival: TUSBEvent read FArrival write FArrival;
    Property OnRemoved: TUSBEvent read FRemoved write FRemoved;
  end;

procedure Register;

// Device constants
const
  DBT_DEVICEARRIVAL          =  $00008000;
  DBT_DEVICEREMOVECOMPLETE   =  $00008004;
  DBT_DEVTYP_VOLUME          =  $00000002;
// Device structs
type
  _DEV_BROADCAST_HDR         =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
  end;
  DEV_BROADCAST_HDR          =  _DEV_BROADCAST_HDR;
  TDevBroadcastHeader        =  DEV_BROADCAST_HDR;
  PDevBroadcastHeader        =  ^TDevBroadcastHeader;
type
  _DEV_BROADCAST_VOLUME      =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
     dbcv_unitmask:          DWORD;
     dbcv_flags:             WORD;
  end;
  DEV_BROADCAST_VOLUME       =  _DEV_BROADCAST_VOLUME;
  TDevBroadcastVolume        =  DEV_BROADCAST_VOLUME;
  PDevBroadcastVolume        =  ^TDevBroadcastVolume;

implementation

procedure Register;
begin
  RegisterComponents('Mojtaba', [TUSBDetector]);
end;

{ TUSBDetector }

constructor TUSBDetector.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FWindowHandle := AllocateHWnd(WndProc);
end;

destructor TUSBDetector.Destroy;
begin
  DeallocateHWnd(FWindowHandle);
  inherited Destroy;
end;

procedure TUSBDetector.WMDEVICECHANGE(var Msg: TMessage);
var
  lpdbhHeader: PDevBroadcastHeader;
  lpdbvData:   PDevBroadcastVolume;
  dwIndex:     Integer;
  lpszDrive:   String;
begin
  inherited;
  // Get the device notification header
  lpdbhHeader:=PDevBroadcastHeader(Msg.lParam);
  // Handle the message
  case Msg.WParam of
     DBT_DEVICEARRIVAL:    {a USB drive was connected}
     begin
        if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
        begin
           lpdbvData:=PDevBroadcastVolume(Msg.lParam);
           for dwIndex :=0 to 25 do
           begin
              if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
              begin
                 lpszDrive:=lpszDrive+Chr(65+dwIndex)+ ':';
                 Break;
              end;
           end;
           if Assigned(OnArrival) then
            OnArrival(Self, lpszDrive);
        end;
     end;
     DBT_DEVICEREMOVECOMPLETE:    {a USB drive was removed}
     begin
        if (lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME) then
        begin
           lpdbvData:=PDevBroadcastVolume(Msg.lParam);
           for dwIndex:=0 to 25 do
           begin
              if ((lpdbvData^.dbcv_unitmask shr dwIndex) = 1) then
              begin
                 lpszDrive:=lpszDrive+Chr(65+dwIndex)+ ':';
                 Break;
              end;
           end;
           if Assigned(OnRemoved) then
            OnRemoved(Self, lpszDrive);
        end;
     end;
  end;
end;

procedure TUSBDetector.WndProc(var Msg: TMessage);
begin
  if (Msg.Msg = WM_DEVICECHANGE) then
  begin
    try
      WMDeviceChange(Msg);
    except
      Application.HandleException(Self);
    end;
  end
end;

end.

usbdetector.pas

Kod: Tümünü seç

unit UsbDetector;
 
interface
 
uses Classes;
 
type
  TUsbDriveChanged = procedure (Sender: TObject; Drive: string; Attached: boolean) of object;
 
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
procedure StopUsbDetector;
 
implementation
 
uses Windows, Messages, Forms, SysUtils;
 
type
  TUSBDetector = class(TObject)
  private
    fUsbDriveChanged: TUsbDriveChanged;
  protected
    procedure DeviceChanged(Msg: UINT; wParam, lParam: Longint);
    procedure DoUsbDriveChanged(Drive: string; Attached: Boolean); dynamic;
  public
    constructor Create(NotifyProc: TUsbDriveChanged);
    destructor Destroy; override;
    property OnUsbDriveChanged: TUsbDriveChanged read fUsbDriveChanged;
  end;
 
var mUSBDetector: TUSBDetector;
 
procedure StartUsbDetector(NotifyProc: TUsbDriveChanged);
begin
  if not Assigned(mUsbDetector) then
    mUsbDetector := TUsbDetector.Create(NotifyProc);
end;
 
procedure StopUsbDetector;
begin
  FreeAndNil(mUsbDetector);
  mUsbDetector := nil;
end;
 
{----------------------------------------------------------------------------}
// Device constants
const
  DBT_DEVICEARRIVAL          =  $00008000;
  DBT_DEVICEREMOVECOMPLETE   =  $00008004;
  DBT_DEVTYP_VOLUME          =  $00000002;
 
// Device structs
type
  _DEV_BROADCAST_HDR         =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
  end;
  DEV_BROADCAST_HDR          =  _DEV_BROADCAST_HDR;
  TDevBroadcastHeader        =  DEV_BROADCAST_HDR;
  PDevBroadcastHeader        =  ^TDevBroadcastHeader;
 
type
  _DEV_BROADCAST_VOLUME      =  packed record
     dbch_size:              DWORD;
     dbch_devicetype:        DWORD;
     dbch_reserved:          DWORD;
     dbcv_unitmask:          DWORD;
     dbcv_flags:             WORD;
  end;
  DEV_BROADCAST_VOLUME       =  _DEV_BROADCAST_VOLUME;
  TDevBroadcastVolume        =  DEV_BROADCAST_VOLUME;
  PDevBroadcastVolume        =  ^TDevBroadcastVolume;
 
var
  fPrevWndProc: TFNWndProc = nil;
 
function UsbWndProc(hWnd: HWND; Msg: UINT; wParam, lParam: Longint): Longint; stdcall;
begin
  Result := CallWindowProc(fPrevWndProc, hWnd, Msg, wParam, lParam);
  if (Msg = WM_DEVICECHANGE) and (mUsbDetector <> nil) then
    mUsbDetector.DeviceChanged(Msg, wParam, lParam);
end;
 
constructor TUSBDetector.Create(NotifyProc: TUsbDriveChanged);
begin
  inherited Create;
  fUsbDriveChanged := NotifyProc;
  fPrevWndProc := TFNWndProc(GetWindowLong(Application.Handle, GWL_WNDPROC));
  SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@UsbWndProc));
end;
 
destructor TUSBDetector.Destroy;
begin
  //SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(@fPrevWndProc));
  inherited Destroy;
end;
 
procedure TUSBDetector.DeviceChanged(Msg: UINT; wParam, lParam: LongInt);
var
  lpdbhHeader: PDevBroadcastHeader;
  lpdbvData: PDevBroadcastVolume;
  dwIndex: Integer;
  lpszDrive: string;
begin
  // Get the device notification header
  lpdbhHeader := PDevBroadcastHeader(lParam);
  // Handle the message
  lpszDrive := 'Drive ';
  case WParam of
    DBT_DEVICEARRIVAL:    {a USB drive was connected}
    begin
      if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      begin
        lpdbvData := PDevBroadcastVolume(lParam);
        for dwIndex := 0 to 25 do
        begin
          if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
          begin
            lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
            break;
          end;
        end;
        DoUsbDriveChanged(lpszDrive, True);
      end;
    end;
    DBT_DEVICEREMOVECOMPLETE:    {a USB drive was removed}
    begin
      if lpdbhHeader^.dbch_devicetype = DBT_DEVTYP_VOLUME then
      begin
        lpdbvData := PDevBroadcastVolume(lParam);
        for dwIndex := 0 to 25 do
        begin
          if (lpdbvData^.dbcv_unitmask shr dwIndex) = 1 then
          begin
            lpszDrive := lpszDrive + Chr(65 + dwIndex) + ':';
            break;
          end;
        end;
        DoUsbDriveChanged(lpszDrive, False);
      end;
    end;
  end;
end;
 
procedure TUSBDetector.DoUsbDriveChanged(Drive: string; Attached: Boolean);
begin
  if Assigned(fUsbDriveChanged) then
    fUsbDriveChanged(Self, Drive, Attached);
end;
 
end.

Usb veri yazmak için kullandığım unit ama guidi doğru yazdığım halde genede veriyi yazmıyor.

Kod: Tümünü seç

unit USB;

interface
Uses SysUtils, Forms, Windows;

{******************************************************************************}
{*                       USB - Read / Write Unit                              *}
{*                          by Harald Kubovy                                  *}
{*                                                                            *}
{*  How To USE:                                                               *}
{*  Sending and Reading Data to Device:                                       *}
{*  string_result:= RWUSB('DATA TO SEND IN HEX', Read, Timeout);              *}
{*                                                                            *}
{*  EXAMPLE (ONLY SENDING):                                                   *}
{*  s:= RWUSB('FF FF FF');                                                    *}
{*                                                                            *}
{*  s is String Result of Readed Data from Device                             *}
{*  'FF FF FF' is Data to Send in Hex  (this will send FFFFFF to Device       *}
{*                                                                            *}
{*                                                                            *}
{*  EXAMPLE WITH READING AFTER WRITING:                                       *}
{*  s:= RWUSB('FFFF', 16);                                                    *}
{*                                                                            *}
(*  16 = How mutch to Read / 0 for no Reading                                 *)
{*                                                                            *}
{*  EXAMPLE WITH TIMEOUT:                                                     *}
{*  s:= RWUSB('FFFF', 16, 100);                                               *}
{*                                                                            *}
{*  100 is the Reading Timeout, Standart is 500/ms.                           *}
{*                                                                            *}
{*                                                                            *}
{* Copyright - Do whatever you whant with it  ;o)                             *}
{******************************************************************************}



type
TSetofChars = Set of Char;

  Function USBOpenDriver:boolean;
  Function USBCloseDriver:boolean;
  function USBReadText(BytesRead: cardinal; timeout: cardinal = 500): string;
  function USBReadHEX(BytesRead: cardinal; timeout: cardinal = 500): string;
  function RWUSB(frame: string; readLen:integer = 0; ReadTimeout: integer = 500; Typ : String = 'HEX') : string;
  procedure USBWriteHEX(frame: string);

implementation


{ Get Handle of DeviceDriver }
var USBPORT:Thandle = INVALID_HANDLE_VALUE;

{$HINTS OFF}
{ Open USB Driver }
Function USBOpenDriver:boolean;
begin
  // Open Device Path  \\?\USB#Vid_058b&Pid_0015#5&25ea51ff&0&1#{a5dcbf10-6530-11d2-901f-00c04fb951ed}
  USBPORT:= CreateFile('\\?\USB\VID_0FCE&PID_ADDE&REV_0100{2AEB0243-6A6E-486B-82FC-D815F6B97006}', GENERIC_WRITE or GENERIC_READ,
  FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_FLAG_OVERLAPPED OR FILE_ATTRIBUTE_NORMAL, 0);
  USBOpenDriver:= USBPORT <> INVALID_HANDLE_VALUE;
  if USBPORT = INVALID_HANDLE_VALUE then // error at open port
    begin
      result:=false;
    end else result:=true;
end;
{$HINTS ON}


Function USBCloseDriver:boolean;
begin
  USBCloseDriver := CloseHandle(USBPORT);
  USBPORT := INVALID_HANDLE_VALUE;
end;


function NurBestimmteZeichen (const aValue : String; aChars : TSetofChars) : String;
var
  i: Integer;
  newString : string;
begin
  newString := '';
  for i := 0 to Length(aValue) do
  begin
    if aValue[i] in aChars then
    begin
      newString := newString + aValue[i];
    end;
  end;
  result := newString;
end;



Function HexToStr(s: String): String;
Var
 i : Integer;
Begin
  Result:=''; i:=1;
  While i<Length(s) Do
  Begin
    Result:=Result+Chr(StrToIntDef('$'+Copy(s,i,2),0));
    Inc(i,2);
  End;
End;


Function StrToHex(s: String): String;
Var
  i : Integer;
Begin
  Result:='';
  If Length(s)>0 Then
    For i:=1 To Length(s) Do Result:=Result+IntToHex(Ord(s[i]),2);
End;



Function USBReadTEXT(BytesRead : dWord; timeout: cardinal = 500) : string;
var
  d: array[0..10000] of byte; {Readed Data}
  s, buffer: string;
  i, Tmp: Integer;
  Ovr : TOverlapped;
  count :cardinal; {Count = How mutch Readed Bytes}
begin
  Result := '';
  count:=0;
  Fillchar( d, sizeof(d), 0 );
  FillChar(Ovr, SizeOf(TOverlapped), 0);
  Ovr.hEvent := CreateEvent(nil, true, FALSE, nil);
  if not ReadFile(USBPORT, d, BytesRead, count, @ovr) then
    if GetLastError=Error_IO_Pending then
      if WaitForSingleObject(ovr.hEvent, timeout) = WAIT_OBJECT_0 then
        GetOverlappedResult(USBPORT, ovr, count, false)
  else CancelIo(USBPORT);
  CloseHandle(Ovr.hEvent);
  s := '';
  for i := 0 to count-1 do
  begin
    Tmp:=ord(d[i]);
    s := s + Char(Tmp);
  end;
  {Convert to String Text}
  s := strtohex(s);
  buffer:='';
  for i:=1 to length(s) do
  begin
    if Odd(i) then
    begin
      buffer := '';
      buffer := hextostr(s[i] + s[i+1]);
      buffer := NurBestimmteZeichen(buffer,['0'..'9','a'..'z','A'..'Z','.'..':',' '..'?']);
      result := result+buffer;
    end;
  end;
end;



Function USBReadHEX(BytesRead : dWord; timeout: cardinal = 500) : string;
var
  d: array[0..10000] of byte; {Readed Data}
  s: string;
  i, Tmp: Integer;
  Ovr : TOverlapped;
  count :cardinal; {Count = How mutch Readed Bytes}
begin
  Result := '';
  count:=0;
  Fillchar( d, sizeof(d), 0 );
  FillChar(Ovr, SizeOf(TOverlapped), 0);
  Ovr.hEvent := CreateEvent(nil, true, FALSE, nil);
  if not ReadFile(USBPORT, d, BytesRead, count, @ovr) then
    if GetLastError=Error_IO_Pending then
      if WaitForSingleObject(ovr.hEvent, timeout) = WAIT_OBJECT_0 then
        GetOverlappedResult(USBPORT, ovr, count, false)
  else CancelIo(USBPORT);
  CloseHandle(Ovr.hEvent);
  s := '';
  for i := 0 to count-1 do
  begin
    Tmp:=ord(d[i]);
    s := s + Char(Tmp);
  end;
  Result := strtohex(s);
end;



Function _USBWritePointerA(bp : Pointer; SizeToSend : DWord; timeout: integer) : Cardinal;
var
  Ovr : TOverlapped;
begin
    Result := 0;
    FillChar(Ovr, SizeOf(TOverlapped), 0);
    Ovr.hEvent := CreateEvent(nil, true, FALSE, nil);
    if not WriteFile(USBPort, bp^, SizeToSend, Result, @ovr) then
        if GetLastError=Error_IO_Pending then
            if WaitForSingleObject(ovr.hEvent, timeout) = WAIT_OBJECT_0 then
                GetOverlappedResult(USBPORT, ovr, Result, false)
            else CancelIo(USBPORT);
    CloseHandle(Ovr.hEvent);
end;



procedure USBWriteHEX(frame: string);
var
  BytesWritten: DWord;
begin
  while Pos(' ', FRAME) > 0 do Delete(FRAME,Pos(' ', FRAME),1);
  frame:=hextostr(frame);
  WriteFile(USBPORT, (Pchar(frame))^, SizeOf(frame), BytesWritten, nil);
end;




Function USBWritePointerA(bp : Pointer; SizeToSend : DWord) : boolean;
begin
  Result := _USBWritePointerA(bp, SizeToSend, $688) = SizeToSend;
end;



Function USBWriteStringA(SendString : String) : boolean;
var
  StrSize : Word;
begin
  StrSize := Length(SendString);
  Result := _USBWritePointerA(@SendString[1], StrSize, $688) = StrSize;
end;


function RWUSB(frame: string; readLen:integer = 0; ReadTimeout: integer = 500; Typ : String = 'HEX') : string;
begin
  while Pos(' ', FRAME) > 0 do Delete(FRAME,Pos(' ', FRAME),1);
  if length(frame) >0 then USBWriteStringA(hextostr(frame));
  Application.ProcessMessages;
  sleep(ReadTimeout);
  if (ReadLen >0) and (Typ='HEX')    then result:=USBReadHEX(readLen, ReadTimeout);
  if (ReadLen >0) and (Typ='STRING') then result:=USBReadText(readLen, ReadTimeout);
end;


end.
Bunların hiçbiri malasef iş görmüyor yada ben başaramadım. Veri yazacağım cihazın donanım kimlikleri şu şekilde.


Resim

Resim

Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 11:07
Konum: İstanbul
İletişim:

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen Kuri_YJ » 25 Nis 2018 03:51

Selamlar,
WinUSB diye bir şey görmüştüm SourceForge'da var. Hem detect ediyor hemde Read/write package sent edebiliyor diye biliyorum.

Onunla denediniz mi?

Kolay Gelin
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/

seci20
Üye
Mesajlar: 229
Kayıt: 25 May 2015 04:39

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen seci20 » 25 Nis 2018 03:53

Kuri_YJ yazdı:
25 Nis 2018 03:51
Selamlar,
WinUSB diye bir şey görmüştüm SourceForge'da var. Hem detect ediyor hemde Read/write package sent edebiliyor diye biliyorum.

Onunla denediniz mi?

Kolay Gelin
yok hocam hemen deniyorum. Dikkatımi çekmedi hiç...

seci20
Üye
Mesajlar: 229
Kayıt: 25 May 2015 04:39

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen seci20 » 25 Nis 2018 04:32

Kuri_YJ yazdı:
25 Nis 2018 03:51
Selamlar,
WinUSB diye bir şey görmüştüm SourceForge'da var. Hem detect ediyor hemde Read/write package sent edebiliyor diye biliyorum.

Onunla denediniz mi?

Kolay Gelin
yok hocam malasef buda aynı şekilde hata veriyor ya ben adresleri yanlış yazıyorum çözemedim malasef.

Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 11:07
Konum: İstanbul
İletişim:

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen Kuri_YJ » 25 Nis 2018 04:37

Selamlar,
Önerebileceğim şey,
Programı Debug edin, hata verilen satır ve verilen hatayı kopyalayıp internette bir aratın bakalım. Benzer konularda sıkıntı yaşayanlar vardır mutlaka.
Stackoverflow'da benzer konular görmüştüm.
Bu şekilde bir deneyin bakalım.
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/

seci20
Üye
Mesajlar: 229
Kayıt: 25 May 2015 04:39

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen seci20 » 25 Nis 2018 04:41

Kuri_YJ yazdı:
25 Nis 2018 04:37
Selamlar,
Önerebileceğim şey,
Programı Debug edin, hata verilen satır ve verilen hatayı kopyalayıp internette bir aratın bakalım. Benzer konularda sıkıntı yaşayanlar vardır mutlaka.
Stackoverflow'da benzer konular görmüştüm.
Bu şekilde bir deneyin bakalım.
hocam derlemede sıkıntı yok listeleme yapamıyorum 1. İkinci olarak guid bile doğru yazdığım halde veri gönderemiyorum.

seci20
Üye
Mesajlar: 229
Kayıt: 25 May 2015 04:39

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen seci20 » 27 Nis 2018 07:03

güncel ustalarım hala çözüm bulamadım...

Kullanıcı avatarı
Kuri_YJ
Moderator
Mesajlar: 2247
Kayıt: 06 Ağu 2003 11:07
Konum: İstanbul
İletişim:

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen Kuri_YJ » 28 Nis 2018 03:05

Selamlar,
Denediklerin sonuç vermiyor ise Compoınent düşünebilirsiniz bence.
http://www.deepsoftware.com/nrcomm/

Bu componenti bir deneyin bakalım olacak mı,
Kolay Gelsin
Kuri Yalnız Jedi
Harbi Özgürlük İçin Pisi http://www.pisilinux.org/

seci20
Üye
Mesajlar: 229
Kayıt: 25 May 2015 04:39

Re: Usb cihazlarına veri yazma ve usb cihazlarını listeleme

Mesaj gönderen seci20 » 30 Nis 2018 08:56

Kuri_YJ yazdı:
28 Nis 2018 03:05
Selamlar,
Denediklerin sonuç vermiyor ise Compoınent düşünebilirsiniz bence.
http://www.deepsoftware.com/nrcomm/

Bu componenti bir deneyin bakalım olacak mı,
Kolay Gelsin
hocam evet o eklentiyi kullandım ama malasef cihazı bulduramadım o eklentiye açılış bile yapmadı sanırsam sadece usb diskler için o uygulama

Cevapla