Tüm Platformlar için Hızlı Uygulama Geliştirme Kitabı... Delphi
Ön Sipariş Talebinde Bulunan Üyelerimiz
Sipariş Talebinde Bulunan Üyelerimiz

Konuyu Paylaş : facebook gplus twitter

Konuyu Oyla:
  • Derecelendirme: 4/5 - 1 oy
  • 1
  • 2
  • 3
  • 4
  • 5
Usb cihazlarına veri yazma ve usb cihazlarını listeleme
#1
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

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
{
Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

RegisterDeviceNotification


Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol

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

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

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.


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.


3E0L20.png

RnMkE7.png
Cevapla
#2
Kısacası amacınız; USB Flash Disk içinde bir dosya oluşturup, bu dosyaya bir şeyler yazmak mı?
There's no place like 127.0.0.1
WWW
Cevapla
#3
(25-04-2018, Saat: 16:51)SimaWB Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlKısacası amacınız; USB Flash Disk içinde bir dosya oluşturup, bu dosyaya bir şeyler yazmak mı?

hayır hocam. Usb flash disk değil bu cihaza yazılım atmak için bu port usb kullanılıyor. Amacım yazılım yüklemek.
Cevapla
#4
O zaman bir USB sürücüsü(driver) olması lazım yada yazılması lazım.
USB sürücünüz var mı? Cihaz PCye takıldığında Aygıt Yöneticisinde gözüküyor mu?
There's no place like 127.0.0.1
WWW
Cevapla
#5
(26-04-2018, Saat: 10:10)SimaWB Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlO zaman bir USB sürücüsü(driver) olması lazım yada yazılması lazım.
USB sürücünüz var mı? Cihaz PCye takıldığında Aygıt Yöneticisinde gözüküyor mu?

hocam pc takıldığında yukardaki resimdeki gibi gözüküyor. O port üzerinden veri yazılıyor cihaza.

(26-04-2018, Saat: 10:10)SimaWB Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlO zaman bir USB sürücüsü(driver) olması lazım yada yazılması lazım.
USB sürücünüz var mı? Cihaz PCye takıldığında Aygıt Yöneticisinde gözüküyor mu?





Bu şekilde yükleme işlemi yapılıyor.
Cevapla
#6
konu güncel ustalarım hala çözüm bulamadım...
Cevapla
#7
Merhaba.

- Bir ihtimal veriyorum, işletim sisteminiz x64 ise donanıma erişim için müsaade etmesi için sizin de projenizi x64 şeklinde çıktı almanız lazım. 

- Bunu nereden deneyimledim, bazen kurumdaki CCTV (yerel güvenlik kamerası) donanımı ile Gigabit LAN adaptörümü Disable/Enable şeklinde kapatıp açmam gerekiyor. Bunu yapabilmek için sistem x64 olduğundan projenin de x64 çıktı alması gerekti ondan biliyorum Idea .
Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#8
(27-04-2018, Saat: 21:12)mrmarman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlMerhaba.

- Bir ihtimal veriyorum, işletim sisteminiz x64 ise donanıma erişim için müsaade etmesi için sizin de projenizi x64 şeklinde çıktı almanız lazım. 

- Bunu nereden deneyimledim, bazen kurumdaki CCTV (yerel güvenlik kamerası) donanımı ile Gigabit LAN adaptörümü Disable/Enable şeklinde kapatıp açmam gerekiyor. Bunu yapabilmek için sistem x64 olduğundan projenin de x64 çıktı alması gerekti ondan biliyorum Idea .

yok hocam şuan derledim baktım gene malasef gönderemedim. Open device dahi yapmıyor.
Cevapla
#9
Bendeki Note4 için Open işlemi başarılı oldu. 
Bence sizin cihazı algılama şeklinizi değiştirmeniz lazım.

Sorun şu satırda.

Kod:
 USBPORT:= CreateFile('\\?\USB\VID_0FCE&PID_ADDE&REV_0100{2AEB0243-6A6E-486B-82FC-D815F6B97006}', GENERIC_WRITE or GENERIC_READ,

Sizin için bir örnek hazırladım. 
(1) Registry Class GUID içinden cihazların listesini çektim. 
(2) Oradan bir ListBox'a atanmasını sağladım.
(3) Seçili olan cihazınızı USB OpenDevice fonksiyonunu uyguladım.

Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol tanımlarının açılımlarını inceleyebilirsiniz.
Buna bir KickStart diyelim. Gerisi size kalmış.
Forma bir tane TListBox ekleyin iki de Button aşağıdakileri uygulayın. Idea

Ek bilgi: cihazları ListBox'a alma sırasında  birer birer OpenDevice yapın, FALSE dönenleri listeye almayın. Böylece liste bağlantısı gerçekleşmiş cihazlardan oluşacaktır.

Başarılar.
Procedure CihazListesiAl( strGUID:String; Bilgiler:TStrings );
Const
  BaslaKEY = '\SYSTEM\ControlSet001\Control\Class\';
Var
  Reg               : TRegistry;
  strKey,
  strWpdDevicePnPID : String;
  Liste             : TStringList;
begin
  Reg := TRegistry.Create;
  Try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    strKey      := BaslaKEY + strGUID;

    if Reg.OpenKeyReadonly( strKey ) then
    begin
      Liste := TStringList.Create;
      Try
        Reg.GetKeyNames( Liste );
        while Liste.Count > 0 do
        begin
          // Tekrar bir önceki, üst ağaç dalına dönüyoruz...
          Reg.OpenKeyReadonly( strKey );
          if Reg.OpenKeyReadOnly( Liste[0] ) then
          begin
            if Reg.OpenKeyReadOnly('DeviceData') then
            begin
              strWpdDevicePnPID   := Reg.ReadString('WpdDevicePnPID');
              if Trim(strWpdDevicePnPID) <> ''
                then Bilgiler.Add( Format('%s', [strWpdDevicePnPID]) );
            end;
          end;
          Liste.Delete(0);
        end;
      Finally
        Liste.Free;
      End;
    end;
  Finally
    Reg.Free;
  End;
end;

var
  USBPORT : THandle = INVALID_HANDLE_VALUE;

Function USBOpenDriver( strDev: String ):boolean;
begin
  USBPORT:= CreateFile( PChar(strDev),
                        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;

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

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if ListBox1.ItemIndex < 0 then Exit;

  if USBOpenDriver( ListBox1.Items[ListBox1.ItemIndex] )
    then ShowMessage('port açıldı...')
    else ShowMessage('port sorun oldu açılamadı...')
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  CihazListesiAl( '{eec5ad98-8080-425f-922a-dabf3de3f69a}', ListBox1.Items );
end;


Saygılarımla
Muharrem ARMAN

guplouajuixjzfm15eqb.gif


Cevapla
#10
(28-04-2018, Saat: 00:06)mrmarman Adlı Kullanıcıdan Alıntı: Linkleri Görebilmeniz İçin Giriş yap veya Üye OlBendeki Note4 için Open işlemi başarılı oldu. 
Bence sizin cihazı algılama şeklinizi değiştirmeniz lazım.

Sorun şu satırda.

Kod:
 USBPORT:= CreateFile('\\?\USB\VID_0FCE&PID_ADDE&REV_0100{2AEB0243-6A6E-486B-82FC-D815F6B97006}', GENERIC_WRITE or GENERIC_READ,

Sizin için bir örnek hazırladım. 
(1) Registry Class GUID içinden cihazların listesini çektim. 
(2) Oradan bir ListBox'a atanmasını sağladım.
(3) Seçili olan cihazınızı USB OpenDevice fonksiyonunu uyguladım.

Linkleri Görebilmeniz İçin Giriş yap veya Üye Ol tanımlarının açılımlarını inceleyebilirsiniz.
Buna bir KickStart diyelim. Gerisi size kalmış.
Forma bir tane TListBox ekleyin iki de Button aşağıdakileri uygulayın. Idea

Ek bilgi: cihazları ListBox'a alma sırasında  birer birer OpenDevice yapın, FALSE dönenleri listeye almayın. Böylece liste bağlantısı gerçekleşmiş cihazlardan oluşacaktır.

Başarılar.
Procedure CihazListesiAl( strGUID:String; Bilgiler:TStrings );
Const
  BaslaKEY = '\SYSTEM\ControlSet001\Control\Class\';
Var
  Reg               : TRegistry;
  strKey,
  strWpdDevicePnPID : String;
  Liste             : TStringList;
begin
  Reg := TRegistry.Create;
  Try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    strKey      := BaslaKEY + strGUID;

    if Reg.OpenKeyReadonly( strKey ) then
    begin
      Liste := TStringList.Create;
      Try
        Reg.GetKeyNames( Liste );
        while Liste.Count > 0 do
        begin
          // Tekrar bir önceki, üst ağaç dalına dönüyoruz...
          Reg.OpenKeyReadonly( strKey );
          if Reg.OpenKeyReadOnly( Liste[0] ) then
          begin
            if Reg.OpenKeyReadOnly('DeviceData') then
            begin
              strWpdDevicePnPID   := Reg.ReadString('WpdDevicePnPID');
              if Trim(strWpdDevicePnPID) <> ''
                then Bilgiler.Add( Format('%s', [strWpdDevicePnPID]) );
            end;
          end;
          Liste.Delete(0);
        end;
      Finally
        Liste.Free;
      End;
    end;
  Finally
    Reg.Free;
  End;
end;

var
  USBPORT : THandle = INVALID_HANDLE_VALUE;

Function USBOpenDriver( strDev: String ):boolean;
begin
  USBPORT:= CreateFile( PChar(strDev),
                        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;

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

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  if ListBox1.ItemIndex < 0 then Exit;

  if USBOpenDriver( ListBox1.Items[ListBox1.ItemIndex] )
    then ShowMessage('port açıldı...')
    else ShowMessage('port sorun oldu açılamadı...')
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  CihazListesiAl( '{eec5ad98-8080-425f-922a-dabf3de3f69a}', ListBox1.Items );
end;



hocam siz elleri öpülesi bir insansınız çok çok teşekkür ederim... Smile
Cevapla

Konuyu Paylaş : facebook gplus twitter



Konu ile Alakalı Benzer Konular
Konular Yazar Yorumlar Okunma Son Yorum
  array den veri okuma klavye 3 86 05-11-2018, Saat: 13:28
Son Yorum: klavye
  Comporttan veri bittiğini nasıl anlarız ? seci20 11 264 21-10-2018, Saat: 17:54
Son Yorum: arsl01
  Delphi Bağlı Liste Ekleme,Silme,Listeleme narkotik 1 123 21-10-2018, Saat: 14:59
Son Yorum: sabanakman
  Unidac veri ekleme arsl01 3 167 29-09-2018, Saat: 17:06
Son Yorum: arsl01
  Delphi & FTP txt veri işleme Mr.Developer 21 720 28-09-2018, Saat: 08:21
Son Yorum: Fesih ARSLAN



Konuyu Okuyanlar: 1 Ziyaretçi