Mensajes

Hola, no tenes que hacer nada, el lector de codigo de barras se conecta como si fuera el teclado a la pc, y cuando lees un codigo y estas posicionado en algun campo de texto, el lector escribe el codigo leido y manda un enter despues.

saludos.

bloqueen el post

[drag & drop]

el ejemplo que te pase usa el evento drag & drop del formulario, por eso el codigo esta metido ahi en ese vento, pero vos lo podes sacar de ahi y meterlo donde quieras...la clase dejala igual, aca te paso un ejemplo de como obtener la organizacion de un archivo de algun path que vos le pongas:

Código (vb) [Seleccionar] Expandir

Dim oFileInfo As FileVersionInfo

Private Sub Form_Load()
    Set oFileInfo = New FileVersionInfo
   
    Dim vStr As String
   
    oFileInfo.GetFileVersionInfo "C:\proyecto1.exe"
   
    vStr = "Product Name : " & oFileInfo.ProductName
    vStr = vStr & vbCrLf & "Product Version     : " & oFileInfo.ProductVersion
    vStr = vStr & vbCrLf & "Company Name    : " & oFileInfo.CompanyName
    vStr = vStr & vbCrLf & "File Description   : " & oFileInfo.FileDescription
    vStr = vStr & vbCrLf & "File Version    : " & oFileInfo.FileVersion
    vStr = vStr & vbCrLf & "Internal Name    : " & oFileInfo.InternalName
    vStr = vStr & vbCrLf & "Original Filename    : " & oFileInfo.OriginalFilename
    vStr = vStr & vbCrLf & "Legal Copyright    : " & oFileInfo.LegalCopyright
    vStr = vStr & vbCrLf & "BuildID    : " & oFileInfo.BuildID
    vStr = vStr & vbCrLf & "Comments    : " & oFileInfo.Comments
   
    MsgBox vStr
   
    Set oFileInfo = Nothing
End Sub

saludos.

te falta postear la ultima que puse, fijate que editamos el post casi al mismo tiempo   y pusimos la misma funcion con una diferencia, solo que la tuya hace el vbBinaryCompare.

la de la api que yo posteo creo que no anda con la clase de Mr. Frog ©  porque en la documentacion de la api dice que esta api no devuelve ningun valor, el valor que devuelve lo hace sobre la misma variable que le pasas y por eso creo que la clase que llama a la api espera un resultado que nunca llega y termina en error.

saludos.

[raul338]

raul338 creo que sigue manteniendo las comillas.

Leandro probaste la api CommandLineToArgv ? aca te paso un ejemplo, funciona con caracteres especiales y comillas simples.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private Type MungeLong
   X As Long
   Dummy As Integer
End Type

Private Type MungeInt
   XLo As Integer
   XHi As Integer
   Dummy As Integer
End Type

Private Declare Function CommandLineToArgv Lib "shell32" Alias "CommandLineToArgvW" (ByVal lpCmdLine As String, pNumArgs As Integer) As Long
Private Declare Sub RtlMoveMemory Lib "kernel32" (dest As Any, src As Any, ByVal size&)
Private Declare Function PtrToStr Lib "kernel32" Alias "lstrcpyW" (RetVal As Byte, ByVal Ptr As Long) As Long
Private Declare Function PtrToInt Lib "kernel32" Alias "lstrcpynW" (RetVal As Any, ByVal Ptr As Long, ByVal nCharCount As Long) As Long
Private Declare Function StrLen Lib "kernel32" Alias "lstrlenW" (ByVal Ptr As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
   
Private Sub Form_Load()
    Dim sarCommand() As String, lngA As Long
   
    sarCommand = ParseCommandLine
   
    For lngA = 0 To UBound(sarCommand)
        MsgBox sarCommand(lngA)
    Next lngA
End Sub

Public Function ParseCommandLine() As String()
   Dim sCommandLineW As String
   Dim BufPtr As Long
   Dim lNumArgs As Integer
   Dim i As Long
   Dim lRes As Long
   Dim TempPtr As MungeLong
   Dim TempStr As MungeInt
   Dim ArgArray(512) As Byte
   Dim Arg As String
   Dim Args() As String

   sCommandLineW = StrConv("C:\Proyecto1.exe ""C:\reto 123.exe"" C:\imagen.png archivo.txt aaa.txt aadada#&%''.txt", vbUnicode)
   BufPtr = CommandLineToArgv(sCommandLineW, lNumArgs)
   ReDim Args(lNumArgs - 1)

   For i = 1 To lNumArgs
       lRes = PtrToInt(TempStr.XLo, BufPtr + (i - 1) * 4, 2)
       lRes = PtrToInt(TempStr.XHi, BufPtr + (i - 1) * 4 + 2, 2)
       LSet TempPtr = TempStr
       lRes = PtrToStr(ArgArray(0), TempPtr.X)
       Arg = Left(ArgArray, StrLen(TempPtr.X))
       Args(i - 1) = Arg
   Next i

   Call GlobalFree(BufPtr)
   ParseCommandLine = Args
End Function

Public Function IsEmptyArray(TestArray As Variant) As Boolean
   Dim lTemp As Long
   On Error GoTo ErrHandler
   lTemp = LBound(TestArray)
   IsEmptyArray = False
   Exit Function
ErrHandler:
   IsEmptyArray = True
End Function

saludos.

[79137913]

con razon la de 79137913 a veces decia mas y otras menos, en realidad no la estaba usando, usaba 2 veces la funcion mia  , ahi corregi el codigo de las funciones, en mi post, aparte fijate 79137913 que esta mal porque no estas eliminando los espacios del buffer que creas y eso la hace lentisima, la funcion bien esta aca:

GetFileTitle - Obtener nombre de archivo de un path

o sea seria:

Código (vb) [Seleccionar] Expandir

Private Function Fn7913(ByVal sPath As String) As String
   Dim Buffer As String
   Buffer = String(255, 0)
   GetFileTitle sPath, Buffer, Len(Buffer)
   Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
End Function

igual sigue un poco mas lenta que las demas.

@ Mr. Frog ©

la funcion que posteaste no funciona, solo le quita el directorio principal.

aca va otra, esta tarda la mitad de la ultima que habia posteado.

Código (vb) [Seleccionar] Expandir

Public Function GetFileName123(ByRef vPath As String) As String
    GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\"))
End Function

saludos.

[CTiming]

con la clase CTiming, la podes bajar de aca:

CTiming

aca va el codigo, con las funciones posteadas hasta ahora. pongan un boton en el form y este codigo.

Código (vb) [Seleccionar] Expandir

Option Explicit

Private CTiming As CTiming

Private Declare Function GetFileTitle Lib "comdlg32.dll" Alias "GetFileTitleA" (ByVal lpszFile As String, ByVal lpszTitle As String, ByVal cbBuf As Integer) As Integer
Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)

Const Path As String = "C:\Documents and Settings\Llamazares\Mis documentos\Downloads\SexoDeRanas.avi"

Dim i As Long
Dim ValTest As Long
Dim vres As String

Private Sub Command1_Click()
    Me.Print "Test de velocidad" & vbCrLf
   
    ValTest = 10000
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = StripPath(Path)
    Next
   
    Me.Print "seba123neo api: " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = GetFileName(Path)
    Next
   
    Me.Print "ignorantev1.1: " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = getFileName2(Path)
    Next
   
    Me.Print "seba123neo (ignorantev1.1): " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = Fn7913(Path)
    Next
   
    Me.Print "79137913: " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = nombre_archivo(Path)
    Next
   
    Me.Print "grester43hck: " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = GetFileMrFrog(Path)
    Next
   
    Me.Print "Mr. Frog ©: " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = GetFileName123(Path)
    Next
   
    Me.Print "seba123neo (segunda): " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = SacarFilenameE_C(Path)
    Next
   
    Me.Print "Elemental Code: " & CTiming.sElapsed
   
    CTiming.Reset
   
    For i = 0 To ValTest
        vres = SacarFilenameE_Cv2(Path)
    Next
   
    Me.Print "Elemental Code 2: " & CTiming.sElapsed
   
End Sub

Private Sub Form_Load()
    Set CTiming = New CTiming
    Me.AutoRedraw = True
End Sub

Private Function StripPath(ByVal sPath As String) As String
   Call PathStripPath(sPath)
   StripPath = sPath
End Function

Private Function getFileName2(ByVal Path As String) As String
    getFileName2 = Mid$(Path, InStrRev(Path, "\") + 1)
End Function

Private Function GetFileName(ByVal Path As String) As String
    Dim cM As Integer
    cM = InStrRev(Path, "\") + 1
    If cM = 0 Then Exit Function
    GetFileName = Mid(Path, cM)
End Function

Private Function Fn7913(ByVal sPath As String) As String
    Dim Buffer As String
    Buffer = String(255, 0)
    GetFileTitle sPath, Buffer, Len(Buffer)
    Fn7913 = Left$(Buffer, InStr(1, Buffer, Chr$(0)) - 1)
End Function

Private Function nombre_archivo(ByVal Ruta As String) As String
    Dim partes() As String
    partes = Split(Ruta, "\")
    nombre_archivo = partes(UBound(partes))
End Function

Public Static Function GetFileMrFrog(ByRef sFile As String) As String
    GetFileMrFrog = RightB$(sFile, LenB(sFile) - InStrB(sFile, "\") - 1)
End Function

Public Function GetFileName123(ByRef vPath As String) As String
    GetFileName123 = Right$(vPath, Len(vPath) - InStrRev(vPath, "\"))
End Function

Public Function SacarFilenameE_C(ByRef sPath As String) As String
    SacarFilenameE_C = StrReverse(Left(StrReverse(sPath), InStr(1, StrReverse(sPath), "\", vbBinaryCompare) - 1))
End Function

Public Function SacarFilenameE_Cv2(ByRef sPath As String) As String
    SacarFilenameE_Cv2 = Right(sPath, Len(sPath) - InStrRev(sPath, "\", Len(sPath), vbBinaryCompare))
End Function


PD: no vi que era con la clase modificada de Mr. Frog © , pero me imagino que no hay diferencia no ?

saludos.

Seguramente no es la mas rapida ni por asomo xD

no, es lentisima 

las 2 mas rapidas hasta ahora es la segunda que puse yo y la de 79137913, a veces una dura mas y la otra menos, esta en la pelea.

la api es una de las mas compactas, pero es la mas lenta, aca paso una optimizacion de la que puso ignorantev1.1 , es unos 300 milisegundos mas rapida.

Código (vb) [Seleccionar] Expandir

Function getFileName(ByVal path As String) As String
    getFileName = Mid$(path, InStrRev(path, "\") + 1)
End Function

Código (vb) [Seleccionar] Expandir

Private Declare Sub PathStripPath Lib "shlwapi.dll" Alias "PathStripPathA" (ByVal pszPath As String)

Public Function StripPath(ByVal sPath As String) As String
   Call PathStripPath(sPath)
   StripPath = sPath
End Function