Mensajes

[horribles]

Hola.
Los nuevos smylies son horribles.

:'( :shocked:

Me parece que están mejores unos viejos de vaquero que vi hace tiempo.

Saludos.
Angellore.

Hola.
Como dijo ANELKAOS, lo mejor es utilizar la memoria para leer el archivo.

Escribí una función que lee un archivo grande a la memoria y devuelve la dirección base en donde se encuentra, para luego poder leerlo utilizando ReadProcessMemory y modificarlo con WriteProcessMemory. Esta función puede servir para guardar un archivo grande con un par de modificaciones leves.

Las funciones que utilizo se encuentran en la biblioteca win.tlb que encontré en este mismo foro. Sólo hay que agregar como referencia win.tlb y funciona.

Código [Seleccionar] Expandir


Option Explicit

Function ReadLargeFile(ByVal Filename As String) As Long
        Dim lDataChunkSize&
        Dim lNumberOfChunks&
        Dim hFile&, lFileLen&
        Dim lMemOffset&, lReadLen&
        Dim hMem&, i&, r&

  ' Abre el archivo para lectura.
  '
  hFile = CreateFile(Filename, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, _
                     0&, OPEN_EXISTING, 0&, 0&)
 
  If hFile = INVALID_HANDLE_VALUE Then Exit Function
 
  ' Se obtiene el tamaño del archivo.
  '
  lFileLen = GetFileSize(hFile, 0&)
 
  lDataChunkSize = 1024& * 1024&  ' Se leerá de a trozos de 1 MB
 
  ' Si calcula en cuántas veces se leerá el archivo.
  '
  lNumberOfChunks = lFileLen \ lDataChunkSize
   
  If lNumberOfChunks = 0 Then
    lNumberOfChunks = 1 ' El archivo en menor a 1 MB.
  Else
    ' Calcula la longitud de los datos de la última
    ' sección del archivo, que seguramente es menor
    ' a 1 Megabyte.
    '
    If (lFileLen Mod lDataChunkSize) > 0 Then lNumberOfChunks = lNumberOfChunks + 1
  End If
 
  ' Asigna memoria para leer el archivo.
  '
  hMem = VirtualAlloc(0&, lFileLen, MEM_COMMIT, PAGE_READWRITE)
 
  If hMem = 0 Then GoTo FailRead
 
  For i = 1 To lNumberOfChunks
    ' Se verifica si es la última sección del archivo o no.
    '
    If i < lNumberOfChunks Then
      lReadLen = lDataChunkSize
    Else
      lReadLen = lFileLen Mod lDataChunkSize
    End If
   
    ' Lee el trozo del archivo a la memoria.
    '
    r = ReadFile(hFile, ByVal hMem + lMemOffset, lReadLen, 0, ByVal 0&)
   
    If r = 0 Then GoTo FailRead
   
    ' Pasa al siguiente trozo de datos.
    '
    lMemOffset = lMemOffset + lReadLen

    DoEvents
  Next

FailRead:
  If Err.LastDllError <> ERROR_SUCCESS Then
    ' Libera la memoria si no se pudo leer el archivo.
    '
    Debug.Print GetSysErr(Err.LastDllError)
    r = VirtualFree(hMem, 0, MEM_RELEASE)
  Else
    ' Devuelve el puntero al inicio del archivo en memoria.
    '
    ReadLargeFile = hMem
  End If
 
  ' Cierra el archivo.
  '
  r = CloseHandle(hFile)

End Function

Function GetSysErr(ByVal ErrNumber As Long) As String
        Dim sBuffer$, lLen&

  sBuffer = String$(1024, 0)
 
  lLen = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, 0&, ErrNumber, 0&, ByVal sBuffer, 1024, ByVal 0&)
 
  If lLen Then
    sBuffer = Left$(sBuffer, lLen)
  End If
 
  GetSysErr = sBuffer
End Function


Saludos.
Angellore.

Hola.
Para que se ajuste al recuadro establece la propiedad Stretch a True.

Para seleccionar una imagen aleatoria de un directorio simplemente genera un número aleatorio que puede representar el número de archivo, por ejemplo. Luego podrás recorrer el directorio con la función Dir. Para esto se puede hacer de muchas maneras, sólo es una idea.

Saludos.
Angellore.

Hola.
Si sabes usar las APIs en C en VB es exactamente lo mismo.

Hay un par de cosas que debes tener en cuenta, luego es análogo a C:

1. El procedimiento principal en VB es Sub Main. Para que el programa se inicie en esta instancia en Propiedades del Proyecto hay que establecer como elemento de inicio Sub Main.

2. Los punteros de función en VB se pasan con el operador lógico AddressOf, esto servirá cuando haya que establecer la función de ventana WndProc en la clase.

3. Depurar el código en tiempo de ejecución es muy peligroso cuando se trata de callbacks, porque pueden producirse resultados impredecibles.

Luego es el mismo procedimiento que en C. Primero se registra la clase de ventana utilizando RegisterClassEx, se llama a CreateWindow y luego se muestra la ventana con ShowWindow.

Voy a ver si encuentro un ejemplo que tengo guardado por alguna parte, si lo encuentro lo posteo.

Saludos.
Angellore.

Hola.
Podrías utilizar la propiedad Tag que tiene cada control y ponerle a cada par igual el mismo valor en dicha propiedad. Esta es la mejor opción para hacer lo que pretendes.

Saludos.
Angellore.

Hola.
Escribí un código que te da información de la impresora especificada, y entre esa información el número de trabajos que tiene en cola. El código siguiente debe ir en un módulo estándar:

Código [Seleccionar] Expandir


Option Explicit

Public Const PRINTER_STATUS_BUSY = &H200
Public Const PRINTER_STATUS_DOOR_OPEN = &H400000
Public Const PRINTER_STATUS_ERROR = &H2
Public Const PRINTER_STATUS_INITIALIZING = &H8000
Public Const PRINTER_STATUS_IO_ACTIVE = &H100
Public Const PRINTER_STATUS_MANUAL_FEED = &H20
Public Const PRINTER_STATUS_NO_TONER = &H40000
Public Const PRINTER_STATUS_NOT_AVAILABLE = &H1000
Public Const PRINTER_STATUS_OFFLINE = &H80
Public Const PRINTER_STATUS_OUT_OF_MEMORY = &H200000
Public Const PRINTER_STATUS_OUTPUT_BIN_FULL = &H800
Public Const PRINTER_STATUS_PAGE_PUNT = &H80000
Public Const PRINTER_STATUS_PAPER_JAM = &H8
Public Const PRINTER_STATUS_PAPER_OUT = &H10
Public Const PRINTER_STATUS_PAPER_PROBLEM = &H40
Public Const PRINTER_STATUS_PAUSED = &H1
Public Const PRINTER_STATUS_PENDING_DELETION = &H4
Public Const PRINTER_STATUS_PRINTING = &H400
Public Const PRINTER_STATUS_PROCESSING = &H4000
Public Const PRINTER_STATUS_TONER_LOW = &H20000
Public Const PRINTER_STATUS_USER_INTERVENTION = &H100000
Public Const PRINTER_STATUS_WAITING = &H2000
Public Const PRINTER_STATUS_WARMING_UP = &H10000

Const ERROR_INSUFFICIENT_BUFFER = 122

Const MEM_COMMIT = &H1000&
Const PAGE_READWRITE = 4
Const MEM_RELEASE = &H8000

Const CCHDEVICENAME = 32
Const CCHFORMNAME = 32

Private Type DEVMODE
  dmDeviceName(1 To CCHDEVICENAME) As Byte
  dmSpecVersion       As Integer
  dmDriverVersion     As Integer
  dmSize              As Integer
  dmDriverExtra       As Integer
  dmFields            As Long
  dmOrientation       As Integer
  dmPaperSize         As Integer
  dmPaperLength       As Integer
  dmPaperWidth        As Integer
  dmScale             As Integer
  dmCopies            As Integer
  dmDefaultSource     As Integer
  dmPrintQuality      As Integer
  dmColor             As Integer
  dmDuplex            As Integer
  dmYResolution       As Integer
  dmTTOption          As Integer
  dmCollate           As Integer
  dmFormName(1 To CCHFORMNAME) As Byte
  dmUnusedPadding     As Integer
  dmBitsPerPel        As Long
  dmPelsWidth         As Long
  dmPelsHeight        As Long
  dmDisplayFlags      As Long
  dmDisplayFrequency  As Long
End Type

Private Type ACL
  AclRevision As Byte
  Sbz1        As Byte
  AclSize     As Integer
  AceCount    As Integer
  Sbz2        As Integer
End Type

Private Type SECURITY_DESCRIPTOR
  Revision  As Byte
  Sbz1      As Byte
  Control   As Long
  Owner     As Long
  Group     As Long
  Sacl      As ACL
  Dacl      As ACL
End Type

Private Type PRINTER_INFO_2
  pServerName         As Long ' lpstr
  pPrinterName        As Long ' lpstr
  pShareName          As Long ' lpstr
  pPortName           As Long ' lpstr
  pDriverName         As Long ' lpstr
  pComment            As Long ' lpstr
  pLocation           As Long ' lpstr
  pDevMode            As DEVMODE
  pSepFile            As Long ' lpstr
  pPrintProcessor     As Long ' lpstr
  pDatatype           As Long ' lpstr
  pParameters         As Long ' lpstr
  pSecurityDescriptor As SECURITY_DESCRIPTOR
  Attributes          As Long
  Priority            As Long
  DefaultPriority     As Long
  StartTime           As Long
  UntilTime           As Long
  Status              As Long
  cJobs               As Long
  AveragePPM          As Long
End Type

Type PrinterInfo
  ServerName      As String ' Nombre del servidor donde se encuentra (si es local sería localhost).
  PrinterName     As String ' Nombre de la impresora.
  ShareName       As String ' Nombre del recurso compartido.
  PortName        As String ' Nombre del puerto (LPT1, LPT2, etc)
  DriverName      As String ' Nombre del controlador de impresora.
  Comment         As String ' Comentarios.
  Location        As String ' Ubicación.
  PrintProcessor  As String ' Nombre del procesador de la impresora.
  Status          As Long   ' Estado de la impresora.
  Jobs            As Long   ' Cantidad de trabajos en la cola.
  AveragePPM      As Long   ' Páginas por minuto que imprime.
End Type

Public Declare Function OpenPrinter Lib "winspool.drv" Alias "OpenPrinterA" (ByVal pPrinterName As String, phPrinter As Long, ByVal pDefault As Long) As Long
Public Declare Function GetPrinter Lib "winspool.drv" Alias "GetPrinterA" (ByVal hPrinter As Long, ByVal Level As Long, pPrinter As Any, ByVal cbBuf As Long, pcbNeeded As Long) As Long
Public Declare Function ClosePrinter Lib "winspool.drv" (ByVal hPrinter As Long) As Long

Public Declare Function VirtualAlloc Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal flAllocationType As Long, ByVal flProtect As Long) As Long
Public Declare Function VirtualFree Lib "kernel32" (ByVal lpAddress As Long, ByVal dwSize As Long, ByVal dwFreeType As Long) As Long
Public Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, lpBuffer As Any, ByVal nSize As Long, Optional lpNumberOfBytesWritten As Long) As Long
Public Declare Function lstrlenptr Lib "kernel32" Alias "lstrlenA" (ByVal lpString As Long) As Long

Public Declare Function GetCurrentProcess Lib "kernel32" () As Long

Function GetPrinterInfo(ByVal DeviceName As String) As PrinterInfo
        Dim lpPrinterInfo As PRINTER_INFO_2
        Dim lBytesNeeded&, hPrinter&
        Dim hMem&, r&


  ' Abre la impresora y devuelve un controlador de impresora (hPrinter).
  '
  r = OpenPrinter(DeviceName, hPrinter, 0&)

  If r = 0 Then
    Debug.Print "No se pudo abrir la impresora especificada"
   
    Exit Function
  End If
 
  ' Primero obtiene el tamaño de los datos para
  ' la impresora especificada.
  '
  r = GetPrinter(hPrinter, 2, 0&, 0&, lBytesNeeded)
 
  If Err.LastDllError = ERROR_INSUFFICIENT_BUFFER Then
    ' Asigna memoria para utilizarla como buffer en
    ' la llamada a la función GetPrinter.
    '
    hMem = VirtualAlloc(0&, lBytesNeeded, MEM_COMMIT, PAGE_READWRITE)
   
    ' Ahora sí obtiene la información de la impresora especificada.
    '
    r = GetPrinter(hPrinter, 2, ByVal hMem, lBytesNeeded, lBytesNeeded)
   
    If r = 0 Then GoTo GetInfoFail
   
    ' Copia los datos a la variable lpPrinterInfo.
    '
    r = ReadProcessMemory(GetCurrentProcess, hMem, lpPrinterInfo, LenB(lpPrinterInfo))
    r = VirtualFree(hMem, 0&, MEM_RELEASE)  ' Libera la memoria.
  Else
GetInfoFail:
    Debug.Print "No se puede obtener información de la impresora."
   
    GoTo PrinterFault
  End If
 
  With GetPrinterInfo
    .AveragePPM = lpPrinterInfo.AveragePPM
    .Comment = PtrToStrA(lpPrinterInfo.pComment)
    .DriverName = PtrToStrA(lpPrinterInfo.pDriverName)
    .Jobs = lpPrinterInfo.cJobs
    .Location = PtrToStrA(lpPrinterInfo.pLocation)
    .PortName = PtrToStrA(lpPrinterInfo.pPortName)
    .PrinterName = PtrToStrA(lpPrinterInfo.pPrinterName)
    .PrintProcessor = PtrToStrA(lpPrinterInfo.pPrintProcessor)
    .ServerName = PtrToStrA(lpPrinterInfo.pServerName)
    .ShareName = PtrToStrA(lpPrinterInfo.pShareName)
    .Status = lpPrinterInfo.Status
  End With
 
PrinterFault:
  ' Cierra la impresora.
  '
  r = ClosePrinter(hPrinter)

End Function

Function PtrToStrA(ByVal lpAnsiStr As Long) As String
  ' Esta función convierte un puntero de cadena ANSI
  ' en una variable String.
  '
      Dim sData$
      Dim lLen&

  lLen = lstrlenptr(lpAnsiStr)
  sData = String$(lLen, 0)
 
  If ReadProcessMemory(GetCurrentProcess(), lpAnsiStr, ByVal sData, lLen) Then
    PtrToStrA = sData
  End If
End Function


La función GetPrinterInfo sólo necesita un argumento y es el nombre del dispositivo de impresión al que se desea consultar. Para obtener una lista de las impresoras VB proporciona la colección Printers, que se puede recorrer con un bucle For Each...Next

Por ejemplo:

Código [Seleccionar] Expandir


Sub EnumPrinterInfo()
      Dim lpInfo As PrinterInfo
      Dim csPrinter

  For Each csPrinter In Printers
    lpInfo = GetPrinterInfo(csPrinter.DeviceName)
   
    Debug.Print "La impresora " & lpInfo.PrinterName & " tiene " _
                & lpInfo.Jobs & " trabajos en cola."

  Next
End Sub


Saludos.
Angellore.

Hola.
Eso pasa porque al utilizar como procedimiento de inicio Sub Main, el programa terminará cuando salga del procedimiento.

El problema está en que el código de los timers sigue ejecutandose y al haber terminado el procedimiento que los creó, se produce lo que se llama "condición de carrera" y los resultados son impredecibles.

Para solucionar esto, por ejemplo podrías declarar una variable global para que el procedimiento Sub Main monitoree en un bucle hasta que cambie a determinado valor, y recién ahí salir del procedimiento. Por ejemplo:

Código [Seleccionar] Expandir


Public bTerminateApp As Boolean

Sub Main()
  Call SetTimer(0&, 0&, 1000&, AddressOf Timer1)
  Call SetTimer(0&, 0&, 2000&, AddressOf Timer2)
  Call SetTimer(0&, 0&, 3000&, AddressOf Timer3)

  Do While Not bTerminateApp
    DoEvents
  Loop
End Sub

Sub Timer1(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Integer, ByVal dwTime As Long)
  Debug.Print "El idEvent de Timer1 es " & idEvent

  ' Elimina el temporizador.
  '
  Call KillTimer(0&, idEvent)
End Sub

Sub Timer2(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Integer, ByVal dwTime As Long)
  Debug.Print "El idEvent de Timer1 es " & idEvent

  ' Elimina el temporizador.
  '
  Call KillTimer(0&, idEvent)
End Sub

Sub Timer3(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Integer, ByVal dwTime As Long)
  Debug.Print "El idEvent de Timer1 es " & idEvent

  ' Elimina el temporizador.
  '
  Call KillTimer(0&, idEvent)

  ' Cuando termina el tercer temporizador, establece
  ' la variable global a True y el procedimiento Sub Main
  ' sale del bucle de espera.
  '
  bTerminateApp = True
End Sub



En tu caso deberías saber cuando establecer la variable global a bTerminateApp, pero debes tener en cuenta que no tiene que estar ejecutándose ningún timer antes de salir de Sub Main.

Saludos.
Angellore.

[Tutorial: Abrir y Guardar Texto, Control Textbox]

Hola.
Encontré algo en el foro que te puede ayudar.

Tutorial: Abrir y Guardar Texto, Control Textbox

Saludos.
Angellore.

Hola.
Quería agregar que se pueden usar comodines para eliminar todos los archivos del mismo tipo de un directorio. Por ejemplo:

Código [Seleccionar] Expandir


Call Kill("C:\*.jpg")


Saludos.
Angellore.

Hola.
No hace falta utilizar ningún hWnd. En la función callback TimerProc hay un argumento idEvent, ese valor es el que hay que pasarle a la función KillTimer.

Al crear el timer utilizando la función SetTimer, no hay que especificar ningún argumento excepto el puntero de función a TimerProc y el intervalo del temporizador, así dejamos que el sistema elija el idEvent y nos ahorramos de tener que utilizar una variable para guardar esos valores.

El siguiente ejemplo muestra cómo crear varios temporizadores sin que haya conflictos entre ellos.

Código [Seleccionar] Expandir


Sub Main()
  Call SetTimer(0&, 0&, 1000&, AddressOf Timer1)
  Call SetTimer(0&, 0&, 2000&, AddressOf Timer2)
  Call SetTimer(0&, 0&, 3000&, AddressOf Timer3)
End Sub

Sub Timer1(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Integer, ByVal dwTime As Long)
  Debug.Print "El idEvent de Timer1 es " & idEvent

  ' Elimina el temporizador.
  '
  Call KillTimer(0&, idEvent)
End Sub

Sub Timer2(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Integer, ByVal dwTime As Long)
  Debug.Print "El idEvent de Timer1 es " & idEvent

  ' Elimina el temporizador.
  '
  Call KillTimer(0&, idEvent)
End Sub

Sub Timer3(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idEvent As Integer, ByVal dwTime As Long)
  Debug.Print "El idEvent de Timer1 es " & idEvent

  ' Elimina el temporizador.
  '
  Call KillTimer(0&, idEvent)
End Sub


Saludos.
Angellore.