FTP | CCD | Buscar | Trucos | Trabajo | Foros |
|
Registrarse | FAQ | Miembros | Calendario | Guía de estilo | Temas de Hoy |
|
Herramientas | Buscar en Tema | Desplegado |
|
#1
|
|||
|
|||
Conexión USB con celular!
Hola soy nuevo en este foro, estoy comenzando a utilizar este lenguaje, necesito hacer una aplicacion que me conecte con el celular y encontre una libreria (creo que se le llama asi), pero nose como utilizarla en mi code, alguien me podria ayudar a utilizarla??? Probe guardandola como "usb.pas" pero cuando trato de compilar me dice que falta "usb.dcu" y nose porque sucede esto... La libreria es la siguiente y su autor es oOXTCOo... Espero alguien me pueda ayudar.... Gracias!
Código:
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('\\?\USB1', 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. |
#2
|
||||
|
||||
Hola Alan_B.
Como a todos los que se inician te invitamos a que leas nuestra guía de estilo. No tuve inconvenientes en compilar la unidad. En un nuevo proyecto : File-> New-> Unit -> Borrar el contenido que predefine Delphi-> Pegar el código que adjuntaste-> File-> SaveAs: USB.PAS -> compilar. Por si tenes problemas te adjunto el .pas y el .dcu, te aclaro que no probé si el código funciona. Saludos.
__________________
Daniel Didriksen Guía de estilo - Uso de las etiquetas - La otra guía de estilo .... Última edición por ecfisa fecha: 20-09-2012 a las 19:27:44. |
#3
|
|||
|
|||
Gracias Genio!!! Me estoy iniciando y no sabia esto... Y para agregarlo en mo proyecto como tengo que hacer, para que las funciones lo hagan correctamente???
PD: Gracias por tu respuesta, yo soy de Argentina y la verdad que no logro encontrar cursos de Delphi!! Espero progresar gracias a este foro ;-) Vos me darias tips??? EDITADO! Add to project... Shift + F11 Última edición por Alan_B fecha: 03-09-2012 a las 00:29:45. |
#4
|
||||
|
||||
Hola Alan_B.
Hay muchos tips en la sección trucos, además muchos te aparecerán en las mismas búsquedas. Quizá conozcas alguno de los enlaces que te voy a poner, pero si no, espero que te sean útiles:
Un saludo.
__________________
Daniel Didriksen Guía de estilo - Uso de las etiquetas - La otra guía de estilo .... |
#5
|
|||
|
|||
Porque al querer compilar este code:
Código:
procedure TForm1.Button1Click(Sender: TObject); var s:string; begin s:=RWUSB('',32); usb.USBOpenDriver('\\\USB#VID_0C44&PID_0022#5&17C28CDB&0&1#{feb8d079-0681-11d4-9531-0060089abc08}'); memo1.Lines.add(s); end; [Error] Unit1.pas(31): Too many actual parameters [Fatal Error] iDEN.dpr(6): Could not compile used unit 'Unit1.pas' Intente de todo y no logro dar con la posible solucion!!! Ggracias desde ya! |
#6
|
|||
|
|||
El error te indica que estas pasando muchos argumentos a la función.
Si te fijas en la declaración de la función:
Esta no recibe argumentos, y tu le estas enviando:
Como es una función que evalúa si pudo abrir el puerto USB, debería ser:
Saludos |
|
|
Temas Similares | ||||
Tema | Autor | Foro | Respuestas | Último mensaje |
ver los contactos de un celular con delphi | kurono | Varios | 0 | 02-07-2011 00:01:21 |
No pongas el celular en el bolsillo del pantalon | jcarteagaf | La Taberna | 4 | 25-07-2008 19:40:53 |
infectar un celular | ciro.arc | Seguridad | 10 | 19-07-2008 18:00:36 |
Programación de un celular | hugoChinchilla | Conexión con bases de datos | 7 | 14-09-2007 05:09:18 |
Y asi hay gente que se descresta con un celular | mamcx | La Taberna | 3 | 14-03-2007 23:14:20 |
|