30 de marzo de 2016

BindEvent(), RaiseEvent() y UnbindEvents()

Título original: BindEvent(), RaiseEvent(), and UnbindEvents()
Autor: Nancy Folsom
Traducido por: Luis María Guayán


Varios autores han escrito respecto de estas funciones en varias publicaciones desde que las funciones fueron introducidas en la versión 8.0 de Visual FoxPro. En FoxTalk, escribí sobre cómo ellas pueden ser utilizadas para sustituir lo que habían sido las tortuosas notificaciones de objeto editor-suscriptor. En particular, el artículo (http://www.pixeldustindustries.com/articles%5CEventBinding2002_NancyFolsom.pdf) muestra como BindEvent simplifica la interacción entre las capas lógicas de negocio y de presentación.

BindEvent

Use BindEvent para decirle a VFP que cuando ejecute el Método "A", también ejecute el Método "B". Por ejemplo, los botones son un gran medio para los usuarios, para dar a conocer a la computadora que ellos quieren que algo suceda, como guardar datos, ejecutar un informe o preparar una rica taza de té. Podemos, y la mayoría lo tenemos, poner el código para hacer cualquier tarea que se quiera, en el método Click o en cualquier otro objeto que el método Click requiera.

La cosa buena sobre BindEvent consiste en que ahora realmente no hay ninguna razón, jamás, de tener ningún código en un método Click de un botón. Nunca. El botón puede ser mudo como un poste. Si usted pega el siguiente fragmento de código en un archivo PRG y lo ejecuta, usted debería ver el formulario mostrado en la Figura 1.

PUBLIC oForm1
oForm1 = NEWOBJECT("Form1")
RETURN
DEFINE CLASS Form1 AS FORM
  HEIGHT = 90
  WIDTH = 330
  CAPTION = "¿Puede Ud. mantener la ansiedad?"
  NAME = "Form1"
  ADD OBJECT Command1 AS COMMANDBUTTON WITH ;
    TOP = 30, ;
    LEFT = 120, ;
    HEIGHT = 27, ;
    WIDTH = 80, ;
    CAPTION = "No!!!", ;
    NAME = "Command1"
  PROCEDURE INIT
    * Cuando el usuario hace clic en el botón, se
    * dispara el método QueryUnload() del formulario
    BINDEVENT(THISFORM.Command1, 'Click', THISFORM, 'QueryUnload')
    THIS.SHOW()
  ENDPROC
  PROCEDURE QUERYUNLOAD
    THISFORM.RELEASE()
  ENDPROC
ENDDEFINE

Figura 1: Click del botón enlazado al método QueryUnload

El ejemplo no parece muy impresionante ya que podríamos haber llamado simplemente al método QueryUnload desde el método Click del botón de comandos. Sin embargo, esto es efectivamente impresionante porque demuestra algunos conceptos importantes:

  1. BindEvent ahorra escritura de código, y parafraseando al difunto Ed Rauh, menos código que escribo, menos errores (bugs) tengo.
  2. El botón no es especial (excepto el título, quizás) y entonces BindEvents simplifica la jerarquía de objeto.
  3. El objeto que se ocupa por el Click del botón es el mismo responsable de resolver que hacer en caso del evento Click.

Si comenzará a usar BindEvent en situaciones sencillas como ésta, pronto descubrirá que esto no lleva a situaciones mucho más complejas para demostrar que vale la pena.

Vale la pena decir que la función BindEvent no ejecutó ningún código en ninguno de los dos métodos. También vale la pena indicar que cualquier número de objetos puede enlazar a un método. De este modo, por ejemplo, un botón Guardar, un botón Salir, un botón Agregar y una Cuadrícula, pueden estar todos, supongamos, enlazados a un método Guardar en un objeto de negocio. Finalmente podemos enlazar a propiedades además de métodos.

¿Qué ejecuta y cuando ejecuta?

BindEvent tiene un quinto parámetro opcional que determina qué código del método se ejecuta primero. Aquí está otra vez la línea BindEvent:

BindEvent(ThisForm.command1, 'Click', ThisForm, 'QueryUnload')

En primer lugar, en la jerga del archivo de ayuda, el Click del objeto Command1 es el evento y el QueryUnload es el delegado. De este modo, en los parámetros. El quinto parámetro, nflags, es 0 por omisión. Los valores posibles son los siguientes:

Pasando 0 (el valor por omisión) significaría que QueryUnload (el delegado) ejecutará antes el método Click (el evento). Puesto que no tengo ningún código en el método Click, este está perfecto.

Pasando 1 significaría que se dispararía el método Click y luego el método QueryUnload.

Pasando 2 significaría que el QueryUnload no se ejecutaría si un código llama al método Click del botón (expira, es la idea!). De este modo, el método de QueryUnload no se ejecutaría como respuesta al siguiente código:

ThisForm.Command1.Click()

Pasando 3 se combina 1 y 2 (ya que este es un parámetro de bit aditivo).

RaiseEvent()

RaiseEvent() aparenta lo mismo que invocar un método directamente. Sin embargo, hay algunas diferencias importantes. Por ejemplo, supongamos tener una clase Formulario que tiene un método personalizado Guardar. Hemos decidido que cuando el formulario se cierra, cualquier cambio es guardado. Considerando esto, compare:

Procedure QueryUnload
  Local llSaved
  If Thisform.Guardar()
    Thisform.Release()
  Endif
Endproc
y
Procedure QueryUnload
  Local llSaved
  Raiseevent(Thisform,'Guardar')
  Thisform.Release()
Endproc

En el primer ejemplo, la llamada a ThisForm.Guardar() puede no disparar ningún otro método que haya sido enlazado al método Guardar() usando BindEvent al ejecutarse, si el quinto parámetro de BindEvent es 2 ó 3. Sin embargo, el segundo ejemplo RaiseEvent va ha retornar siempre .T., entonces usted no podía usarlo para impedir el cierre del formulario. A veces esto es importante, y a veces no. Mi criterio general es usar RaiseEvent, en vez de un llamado a un método, si no tengo que comprobar el valor devuelto, y si es posible que otros objetos puedan estar enlazados al método que quiero llamar. Es probablemente seguro decir que si un método es un método privado, lógica o físicamente, entonces puede solo llamar al método.

Otro uso para RaiseEvent es para los eventos y métodos nativos que, por si solos, no lanzan un evento VFP cuando son llamados directamente en el código. Aquí el archivo de ayuda es completamente claro en ejemplos, pero, en cuanto lo que se, puedo decir que no hay una lista exhaustiva de métodos y eventos que requerirían un RaiseEvent. En el caso de uno de estos métodos, como Activate, usted puede simplemente lanzar el método desde dentro del método. RaiseEvent aparenta ser capaz de evitar la recursión infinita. De este modo, un método Activate de una forma podría "RaiseEvent" a sí mismo como esta manera:

Procedure Activate 
  RaiseEvent(This,'Activate') 
Endproc 

RaiseEvent permitirá que pase parámetros. Si algún método está enlazado al método que usted lanza, estos tendrán que ser capaces de aceptar parámetros.

RaiseEvent es menos obvio que BindEvent. Por suerte la dos funciones no tienen tanto para hacer necesariamente una con la otra como podría pensar. Entonces, aun cuando no encuentre un uso inmediato para RaiseEvent, trate de incorporar BindEvent tan pronto como pueda.

UnbindEvents()

Desenlace los dos métodos anteriores enlazados conjuntamente con BindEvent. No tiene que desenlazar eventos como algo natural. Sólo desenlace eventos si usted ya no necesita el enlace.

Hay una manera más agradable, con BindEvent y UnbindEvents, de manejar el error que ocurre porque los datos aun no están disponibles para un control, que emplear una combinación Try/Catch para determinar el estado de error, tan pronto como sea posible. Mejor dicho, ¿Cómo un objeto le dice al otro? "Oye, despiérteme cuando tengas tus cosas listas, ¿de acuerdo?" . Pero dejaré esto para otro artículo. La Nota de Referencias es que los enlaces de eventos fueron agregados en Visual FoxPro 8.0. La versión 9.0 agregó la capacidad de enlazar eventos de Windows.

Aquí están algunos enlaces útiles:

Lo invito a que me contacte en nfolsomNOSPAM@NOSPAMpixeldustindustries.com con cualquier comentario, preguntas o crítica. Sus comentarios serán bienvenidos.

Nancy Folsom

27 de marzo de 2016

Utilidad para convertir de Visual Basic a Visual FoxPro

Artículo original: Visual Basic to Visual FoxPro Conversion Utility
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,453c9b02-e964-4311-850b-abcdcd84ddb3.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York


Los ejemplos de código escritos en Visual Basic (versión 6.0 y superior) se encuentran por todas partes. Este recurso puede ser utilizado por muchos desarrolladores Visual FoxPro; pero, convertir un ejemplo de Visual Basic a Visual FoxPro es, en muchos casos un tormento. Es lo mismo una y otra vez... cambiar dims por locals, cambiar msgbox por messagebox y paréntesis en las llamadas de los procedimientos, etc., etc., hasta la saciedad.

Como un programador que ha desarrollado tanto en Visual Basic como en Visual FoxPro, estuve intrigado cuando, hace cerca de un año en Tek-Tips, William GC Steinford ofreció la idea de un convertidor de Visual Basic a Visual FoxPro. He decidido que es una idea excelente y me he creado un convertidor propio. Se rige por una tabla de conversión y controla los aspectos principales que necesitan ser cambiados al traducir de Visual Basic a Visual FoxPro.

Lo he utilizado hace un tiempo y su empleo representa un ahorro real de tiempo. Ahora, tenga presente que no estoy siendo estricto con el código (como he dicho, lo utilizo para mi trabajo, para algunas conversiones "sucias"); pero es funcional y se pueden agregar nuevas sintaxis de conversión desde VB a VFP, que pueden agregarse al programa con sólo agregarlos a la tabla conversion.dbf. Existe un par de campos extras en la tabla que se reservan para usos futuros (serán utilizados para usos tales como convertir la instrucción API Declare adecuadamente y para cualquier otra cosa que no pueda ser traducido en un primer pase con conversion.dbf o necesite un tratamiento especial).

Si añade algo a la tabla de conversión o al programa, le agradecería mucho que me lo haga saber a través de un correo electrónico. Yo estaría encantado de incorporarle cualquier cambio útil, y ofrecerla nuevamente a la comunidad Visual FoxPro. Aparte de eso, es libre de emplearlo cómo y dónde desee.

En el archivo zip se incluye un archivo .BAS en Visual Basic. Cuando ejecute el vbtovfp.exe haga clic en el botón elipse [...] y seleccione el archivo vbsample.bas para abrir la utilidad de conversión. He aquí hay una imagen de la pantalla de vbtovfp y puede bajarlo de vbtovfp.zip 29 Kb.

Nota: Originalmente fue escrito en VFP 7; pero fue trasferido a VFP 9.0 - por lo que es necesario VFP 9.0 para utilizarlo (o dedicarle tiempo a quitar las cosas de VFP 9.0 y recompilarlo en la versión de VFP que utilice). Además, existe una funcionalidad de selección - clic derecho con los controles EditBox que podría querer explorar.

25 de marzo de 2016

Función para convertir colores

Artículo Original: FUNCTION TO CONVERT COLORS
http://weblogs.foxite.com/vfpimaging/2006/11/27/function-to-convert-colors
Autor: Cesar Ch.
Traducido por: Luis María Guayan


La breve función de abajo convierte cualquier color a su versión más oscura o más brillante, tal como el original ColorPicker SlideBar.

Parámetros:
  RGB     - Valor original de RGB para convertir
  tnLevel - Rango de -100 a 100. 
            Cero = Ningún cambio; 100 = Blanco; -100 = Negro; 
            los valores positivos devolverán imágenes mas 
            brillantes, mientras los valores negativos 
            devolveran imagenes mas oscuras.

LPARAMETERS tnRGB, tnLevel

IF tnLevel = 0
  RETURN tnRGB
ENDIF 

tnLevel = tnLevel / 100

LOCAL lnRed, lnGreen, lnBlue
lnRed   = BITAND(tnRGB, 0x000000FF)
lnGreen = BITRSHIFT(BITAND(tnRGB, 0x0000FF00), 8)
lnBlue  = BITRSHIFT(BITAND(tnRGB, 0x00FF0000), 16)

IF tnLevel > 0
  RETURN RGB( ;
    lnRed   + ((255 - lnRed)   * tnLevel) , ;
    lnGreen + ((255 - lnGreen) * tnLevel) , ;
    lnBlue  + ((255 - lnBlue)  * tnLevel) )
ELSE 
  RETURN RGB( ;
    lnRed   + (lnRed   * tnLevel) , ;
    lnGreen + (lnGreen * tnLevel) , ;
    lnBlue  + (lnBlue  * tnLevel) )
ENDIF

Para entender mejor como trabaja esto, puede descargar el archivo adjunto, que contiene un ejemplo simple. Haga Click en el botón "Select Color" para escoger un color y jugar con Spinner para ver los colores más oscuros y más brillantes que resultan.

Descarga: changingcolors.zip 2,37 KB

22 de marzo de 2016

Detectar inactividad

Pueden utilizar la siguiente función para detectar un período de inactividad, ya sea en todo Windows o solamente en la aplicación.

CLEAR
PUBLIC tmrCheck
tmrCheck = NEWOBJECT("DetectActivity")
RETURN

DEFINE CLASS DetectActivity as Timer
  * Sólo detecta inactividad mientras está en este programa?
  JustInThisApp = .T.
  * Intervalo de inactividad tras el cual dispara OnInactivity (en segundos)
  InactivityInterval = 5
  * Intervalo cada el que chequea actividad
  Interval = 1000
  LastCursorPos = ""
  LastKeybState = ""
  LastActivity = DATETIME()
  CursorPos = ""
  KeybState = ""
  IgnoreNext = .T.

  PROCEDURE Init
    DECLARE INTEGER GetKeyboardState IN WIN32API STRING @ sStatus
    DECLARE INTEGER GetCursorPos IN WIN32API STRING @ sPos
    DECLARE INTEGER GetForegroundWindow IN WIN32API
  ENDPROC

  PROCEDURE Destroy
    CLEAR DLLS GetKeyboardState, GetCursorPos, GetForegroundWindow
  ENDPROC

  PROCEDURE Timer
    WITH This
      IF ! .CheckActivity()
        * Si no hubo actividad veo si es tiempo de disparar OnInactivity
        IF ! ISNULL(.LastActivity) AND ;
            DATETIME() - .LastActivity > .InactivityInterval
          .LastActivity = NULL && Prevengo disparo múltiple de OnInactivity
          .OnInactivity()
        ENDIF
      ENDIF
    ENDWITH
  ENDPROC

  * Chequeo si hay actividad
  PROCEDURE CheckActivity
    LOCAL lRet
    WITH This
      IF .JustInThisApp
        IF GetForegroundWindow() <> _VFP.hWnd
          * Estoy en otro programa
          RETURN lRet
        ENDIF
      ENDIF
      .GetCurState()
      IF (!.CursorPos == .LastCursorPos OR !.KeybState == .LastKeybState)
        IF ! .IgnoreNext && La 1ra vez no ejecuto
          lRet = .T. && Hubo actividad
          .OnActivity()
          .LastActivity = DATETIME()
        ELSE
          .IgnoreNext = .F.
        ENDIF
        .LastCursorPos = .CursorPos
        .LastKeybState = .KeybState
      ENDIF
    ENDWITH
    RETURN lRet
  ENDPROC

  * Devuelve el estado actual
  PROCEDURE GetCurState
    LOCAL sPos, sState
    WITH This
      sPos = SPACE(8)
      sState = SPACE(256)
      GetCursorPos (@sPos)
      GetKeyboardState (@sState)
      .CursorPos = sPos
      .KeybState = sState
    ENDWITH
  ENDPROC

  PROCEDURE OnInactivity
    WAIT WINDOW "Inactividad a las " + TIME() NOWAIT
  ENDPROC

  * Hubo actividad
  PROCEDURE OnActivity
    WAIT WINDOW "Actividad a las " + TIME() NOWAIT
  ENDPROC
ENDDEFINE

Mario Lopez

18 de marzo de 2016

Control estructurado de errores con los errores de NEWOBJECT

Artículo original: Structured error handling with NEWOBJECT errors
http://www.spacefold.com/colin/posts/2005/10-04TRY-CATCHvsNEWOBJECT.html
Autor: Colin Nicholls
Traducido por: Ana María Bisbé York



Marcus escribió un artículo muy bueno sobre el control de errores estructurado en VFP 8.0 con TRY-CATCH y versiones posteriores. Me llamó la atención una sección en particular debido a que se refiere a un problema que yo tuve recientemente.

[..] el resultado es el contrario al ejemplo anterior. El evento Error() tiene preferencia sobre el Try/Catch y controla el error dentro del objeto llamado.

¿Qué pasaría entonces si agregamos control estructurado al objeto TestClass?

DEFINE CLASS TestClass AS CUSTOM
FUNCTION Execute
  TRY
    xxxxxx
  CATCH
    MESSAGEBOX("EXCEPTION 2!")
  ENDTRY
ENDFUNC
FUNCTION ERROR(nError, cMethod, nLine)
  MESSAGEBOX(MESSAGE())
ENDFUNC
ENDDEFINE

En este caso, el nuevo Try/Catch va a controlar el error, ya que fue definido en el nivel superior.

Esto no es estricto en todos los casos. Considere el siguiente código:

PROCEDURE Execute
  TRY
    *-----------------------------------------
    * Esto está controlado por el comando
    * TRY_CATCH que lo envuelve:
    *-----------------------------------------
    Y = NEWOBJECT("invalidClass")
    *-----------------------------------------
    * Este ignora el TRY-CATCH y
    * desencadena el evento .Error():
    *-----------------------------------------
    THIS.NEWOBJECT(SYS(2015), "invalidClass", "invalidLib.vcx" )
  CATCH
    MESSAGEBOX("Capturamos satisfactoriamente el ERROR en el CATCH.",64 )
  ENDTRY
ENDPROC
PROCEDURE ERROR(p1, p2, p3 )
  MESSAGEBOX("En su lugar se desencadena el evento ERROR() del objeto!",16)
ENDPROC
ENDDEFINE

El control de errores estructurado funciona según lo previsto para la función NEWOBJECT(), atrapando satisfactoriamente el error "clase no encontrada". Sin embargo, la llamada al método This.NewObject() va a forzar que se dispare el evento Error del objeto, lo que requiere una configuración completamente diferente de código de control de errores para quitar este error. Esto no es un bug, es la forma en la que trabaja el objeto. Los objetos siempre trasladan a su propio evento Error() el control de errores. Es molesto ¿verdad que si?

14 de marzo de 2016

Evento KeyPress

Artículo original: KeyPress Event
http://www.foxpert.com/KnowlBits_200606_2.htm
Autor: Christof Wollenhaupt
Traducido por: Ana María Bisbé


Las teclas especiales como Alt,Ctrl y Mayúsculas tienen este orden de prioridad. Cuando un usuario presiona una combinación de estas teclas, la más prioritaria determina la clave. Por ejemplo, si se presiona la tecla ALT con Mayúsculas, la clave es la misma que al presionar solamente ALT. Si el usuario presiona Mayúsculas y Ctrl, la clave devuelve la combinación de Ctrl. Solamente cuando se presiona únicamente la tecla Mayúsculas, obtendrá la combinación de clave para Mayúsculas. La tabla siguiente muestra el ejemplo para la tecla U:

nKeyCode nShiftAltCtrl
U 117 0
Mayúsculas+U 85 1
Ctrl+U 21 2
Alt+U 22 4
Mayúsculas+Ctrl+U 21 3
Mayúsculas+Alt+U 22 5
Ctrl+Alt+U 22 6
Mayúsculas+Alt+Ctrl+U 22 7 (trabaja intermitentemente en mi portátil.)

La excepción sobre esta regla es la combinación Mayúsculas+ALT en teclados que soportan la combinación de tecla AltGr. Las teclas Mayúsculas+ALT y AltGr+tecla disparan el evento KeyPress con nShiftAltCtrl = 0 y el código normal de la tecla.

Con combinaciones ALT, el código de tecla se corresponde a la localización física en un teclado de EEUU. Al presionar la tecla entre la T y la U en un teclado alemán devuelve un código de tecla igual a 122, mientras que devuelve 121 con un teclado de EEUU. Sin embargo, con la tecla ALT el código es 21 en ambos casos.

Este es el mismo efecto que ocurre con ON KEY LABEL y con cierta combinación de teclas al control hijo como con ALT + guión (ALT+-) en un teclado de EEUU requiere que los usuarios con teclado alemán presionen ALT+ß

Algunas teclas especiales disparan también el evento KeyPress:

nKeyCode nShiftAltCtrl
BloqMayús+Mayúsculas+Alt 58 6 (no fiable)
57 5 (no fiable)
Ctrl+Win+Alt 91 7
Mayúsculas+Alt+0 11 5

Algunos códigos son idénticos. Sin embargo, esto no es necesariamente aplicable a todas las combinaciones de teclas.

nKeyCode nShiftAltCtrl
Ctrl++ / Ctrl+Pos1 29 2
Ctrl+H / Ctrl+Del 127 2
Ctrl+W / Ctrl+End 23 2
Ctrl+Flecha Izquierda / Ctrl+Z 26 2
Ctrl+Flecha Derecha / Ctrl+B 2 2
Alt+0 / Alt+R 19 4
Mayúsculas+Alt+0 19 5
Ctrl+J / Ctrl+Enter 10 3
Mayúsculas+Ctrl+J 10 3
Mayúsculas+Z / Mayúsculas+F7 90 1
Mayúsculas+T / Mayúsculas+F1 84 1
Mayúsculas+U / Mayúsculas+F2 85 1
Mayúsculas+W / Mayúsculas+F4 87 1
Mayúsculas+Y / Mayúsculas+F6 89 1
Mayúsculas+X / Mayúsculas+F5 88 1
Mayúsculas+V / Mayúsculas+F3 86 1

La combinación siguiente no trabaja en unión de Ctrl o Ctrl+Mayúsculas. La primera etiqueta se corresponde con un teclado en alemán y la segunda a un teclado de EEUU.

Alemán Estados Unidos
^ '
1 1
2 2
3 3
4 4
5 5
6 6
7 7
8 8
9 9
ß -
' =
Ö ;
Ä '
, ,
. .
- /

Mayúsculas+F10 es la tecla contextual para el menú y por tanto devuelve nKeyCode=93 y nShiftAltCtrl=1.

Con la tecla BloqMayús, los códigos se invierten.


10 de marzo de 2016

¿Quién tiene abiertos los archivos en la red?

Artículo original: Who has files open on the network
http://www.berezniker.com/content/pages/visual-foxpro/who-has-files-open-network
Autor: Sergey Berezniker
Traducido por: Luis María Guayán


La utilidad WhoHasFileOpen muestra la lista de usuarios que tienen abiertos los archivos específicos en la red. Trabaja en plataforma Windows NT (Windows NT 4.0, Windows 2000, etc.) Este código sólo detecta los archivos abiertos usando una ruta compartida en la red. No retorna los archivos abiertos por un usuario en el equipo local y utilizando una ruta local. El usuario que ejecuta este programa debe ser un miembro del grupo Administradores o del grupo Operadores de Cuentas Locales.

El código está basado en el de Ramon F. Jaquez (UT FAQ # 7896) y modificado para usar exclusivamente código VFP.

El código se usa una clase que soporta la API de Windows (también incluida en la descarga en http://www.berezniker.com/files/WhoHasFileOpen.zip)

Gracias Kevin Delaney por la limpieza del código para que pueda ser publicado en línea para su descarga.

Ejemplos:

PROCEDURE WhoHasFileOpen(tcFileName)

  *-- For Windows NT Platform (NT 4, NT 2000, e.t.c)
  *
  * Based of Ramon F. Jaquez UT FAQ  # 7896
  * Who opened what files on the network? (modified to use only VFP code)
  *
  *--
  * The following program displays the open files, the users that
  * opened these files and other related information.
  *
  * This code detects only the files opened using a net shared
  * path. It does not return the files opened by a user on the
  * local computer using a local path (i.e. the computer where
  * the user is logged on). This is normal, because, otherwise,
  * the number of returned files would be huge.
  *
  * The user running this program must be a member of the
  * Administrators or Account Operators local group.
  *
  * In order to keep the code simple, the error handling only
  * displays the error code. You should integrate it in your
  * error handling mechanism.
  *
  *-- This function returns information about open files.
  *   It returns the open files only if they were
  *   opened using a share on that computer.
  *
  *-- It uses:
  *      - The NetFileEnum Win32 API function to retrieve the wanted information from the OS.
  *
  *-- Parameters:
  *      1. The full file name including path. An extension can be ommited.

  LOCAL lcDriveLetter, lcFileMask, llMask, lcRestName

  #DEFINE PERM_FILE_READ      0x1 && user has read access
  #DEFINE PERM_FILE_WRITE     0x2 && user has write access
  #DEFINE PERM_FILE_CREATE    0x4 && user has create access


  #DEFINE ACCESS_READ         0x01
  #DEFINE ACCESS_WRITE        0x02
  #DEFINE ACCESS_CREATE       0x04
  #DEFINE ACCESS_EXEC         0x08
  #DEFINE ACCESS_DELETE       0x10
  #DEFINE ACCESS_ATRIB        0x20
  #DEFINE ACCESS_PERM         0x40

  #DEFINE ACCESS_GROUP        0x8000

  #DEFINE ACCESS_ALL          ( ACCESS_READ + ACCESS_WRITE + ACCESS_CREATE + ;
    ACCESS_EXEC + ACCESS_DELETE + ACCESS_ATRIB + ACCESS_PERM )

  LOCAL lcServerName, lcBasePath, lcUserName, lnBufferPointer
  LOCAL lnPreferedMaxLength, lnEntriesRead, lnTotalEntries
  LOCAL lnResumeHandle, lnError, loPointersObject
  LOCAL lnI, lcDll, lnPermissions, lnID
  LOCAL llContinue, lnpFileInfo, lcFileName
  LOCAL lnLocks, loRec, lcPermissions

  IF ("?" $ tcFileName) OR ("*" $ tcFileName)
    _msgbox("File Mask is not supported.")
    RETURN
  ENDIF

  IF EMPTY(SYS(2000, DEFAULTEXT(tcFileName,"*")))
    _msgbox("File Name '" + tcFileName + "' not found")
    RETURN
  ENDIF

  IF LEFT(tcFileName,2) = "\\"
    lcNetName = LEFT(tcFileName, AT("\", tcFileName, 4)-1)
    lcRestName = SUBSTR(tcFileName, AT("\", tcFileName, 4)+1)
    lcDriveLetter = lcNetName
  ELSE
    lcDriveLetter = UPPER(JUSTDRIVE(tcFileName))
    IF EMPTY(lcDriveLetter)
      _msgbox("Incorrect File Name '" + tcFileName + "'")
      RETURN
    ENDIF

    * Convert a driver letter to the UNC path
    lcNetName = _LocalName2UNC(lcDriveLetter)
    IF EMPTY(lcNetName)
      _msgbox(lcDriveLetter + " isn't a network drive - '" + tcFileName + "'")
      RETURN
    ENDIF
    lcRestName = SUBSTR(JUSTPATH(tcFileName),4)
  ENDIF

  * Convert share UNC path to the server local path
  lcServerName = "\\" + STREXTRACT(lcNetName, "\\", "\")
  lcLocalPath = _Share2LocalPath(lcNetName)

  IF ISNULL(lcLocalPath)
    RETURN
  ENDIF

  lcBasePath = ADDBS(lcLocalPath) + lcRestName
  lcUserName = ""
  lcFileMask = JUSTFNAME(tcFileName)

  DECLARE INTEGER NetFileEnum IN NETAPI32              ;
    STRING  @ServerName, STRING  @BasePath,            ;
    STRING  @UserName, INTEGER nLevel,                 ;
    INTEGER  @BufferPointer, INTEGER PreferedMaxLength, ;
    INTEGER @EntriesRead, INTEGER @TotalEntries,       ;
    INTEGER @ResumeHandle

  *-- This is the structure used by NetFileEnum to retrieve the information.
  *typedef struct _FILE_INFO_3 {
  * DWORD fi3_id;
  * DWORD fi3_permissions;
  * DWORD fi3_num_locks;
  * LPWSTR fi3_pathname;
  * LPWSTR fi3_username;} FILE_INFO_3

  loWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")

  CREATE CURSOR crsWhoHas ( ;
    UserName C(10), ;
    Locks I, ;
    FileID I, ;
    Permissions C(24), ;
    FileName C(254), ;
    ServerFileName C(254))

  SCATTER MEMO NAME loRec

  *-- The server name, the base path and the user name must be in Unicode format.
  lcServerName = StrConv(StrConv(lcServerName + Chr(0), 1), 5)
  lcBasePath   = StrConv(StrConv(lcBasePath + Chr(0), 1), 5)
  lcUserName   = StrConv(StrConv(lcUserName + Chr(0), 1), 5)

  *-- Allow for a very large buffer.
  *   If this length is not enough, the info
  *   will be retrieved in more than one step.
  lnPreferedMaxLength = 100000000

  lnResumeHandle  = 0
  lnEntriesRead   = 0
  lnTotalEntries  = 0
  lnBufferPointer = 0

  llContinue = .t.
  DO WHILE llContinue
    lnError = NetFileEnum( lcServerName, lcBasePath, lcUserName, 3, ;
      @lnBufferPointer, lnPreferedMaxLength, @lnEntriesRead, ;
      @lnTotalEntries, @lnResumeHandle)
    IF lnEntriesRead = 0
      *-- There are no (more) open files.
      llContinue = .f.
    ENDIF
    IF lnError = 0
      FOR lnI = 1 TO lnEntriesRead
        lnpFileInfo = lnBufferPointer + (lnI - 1) * 20
        lcFileName = loWas.StrZFromBufferW(lnpFileInfo + 12)
        IF UPPER(JUSTFNAME(lcFileName)) <> UPPER(lcFileMask)
          LOOP
        ENDIF
        lnpFileInfo = lnBufferPointer + (lnI - 1) * 20

        *-- Extract the file name
        loRec.FileName   = lcDriveLetter + "\" + STREXTRACT(lcFileName, lcLocalPath, "",1,1)
        loRec.ServerFileName = lcFileName

        *-- Extract the number of locks on this file
        lnLocks = loWas.Long2NumFromBuffer(lnpFileInfo + 8)
        loRec.Locks = lnLocks

        *-- Extract the user name that opened the file
        lcUserName = loWas.StrZFromBufferW(lnpFileInfo + 16)

        loRec.UserName = lcUserName

        *-- Extract the permissions on this file
        lnPermissions = loWas.Long2NumFromBuffer( lnpFileInfo + 4)

        lcPermissions = ""
        IF BITAND(lnPermissions, PERM_FILE_READ) > 0
          lcPermissions = lcPermissions + "Read+"
        ENDIF
        IF BITAND(lnPermissions, PERM_FILE_WRITE) > 0
          lcPermissions = lcPermissions + "Write+"
        ENDIF
        IF BITAND(lnPermissions, PERM_FILE_CREATE) > 0
          lcPermissions = lcPermissions + "Create+"
        ENDIF

        loRec.Permissions = LEFT(lcPermissions, LEN(lcPermissions)-1)

        *-- Extract the ID for this file.
        *   This ID is generated when the file is opened and
        *   can be used as parameter for the NetFileGetInfo
        *   Win32 API function.
        lnID = loWas.Long2NumFromBuffer(lnpFileInfo)
        loRec.FileID = lnID

        INSERT INTO crsWhoHas FROM NAME loRec
      ENDFOR

      *-- Free the memory allocated by NetFileEnum
      IF lnBufferPointer <> 0
        DeAllocNetAPIBuffer(lnBufferPointer)
      ENDIF
    ELSE
      _msgbox("Error No. "+alltrim(str(lnError)),64,'Unable To Continue')
      llContinue = .f.
    ENDIF
  ENDDO

  IF RECCOUNT("crsWhoHas") = 0
    _msgbox("No open files found for '" + tcFileName + "'")
    RETURN
  ENDIF
  SELECT crsWhoHas
  INDEX ON UserName TAG UserName
  LOCATE
  BROWSE LAST NOWAIT NAME oBr
  oBr.ReadOnly = .T.
  oBr.Columns(1).Header1.Caption = "User Name"
  oBr.Columns(3).Header1.Caption = "File ID"
  oBr.Columns(5).Header1.Caption = "File Name"
  oBr.Columns(6).Header1.Caption = "Server File Name"
  oBr.AutoFit()

  RETURN
ENDPROC
*----------------------------------------------------------------------------------

PROCEDURE _apierror
  LPARAMETERS tnErrorCode
  LOCAL lcErrBuffer, lcErrorMess, lnNewErr
  DECLARE Long FormatMessage In kernel32.dll ;
    Long dwFlags, String @lpSource, ;
    Long dwMessageId, Long dwLanguageId, ;
    String @lpBuffer, Long nSize, Long Arguments

  lcErrBuffer = REPL(CHR(0),1000)
  lnNewErr = FormatMessage(0x1000,.NULL., tnErrorCode, 0, @lcErrBuffer,500,0)

  lcErrorMess = TRANSFORM(tnErrorCode) + "    " + LEFT(lcErrBuffer, AT(CHR(0),lcErrBuffer)- 1 )

  RETURN lcErrorMess
ENDPROC
*----------------------------------------------------------------------------------

PROCEDURE _msgbox
  LPARAMETERS tcMessage
  =MESSAGEBOX(tcMessage,16)
  RETURN "OK"
ENDPROC
*----------------------------------------------------------------------------------

PROCEDURE _share2localpath
  LPARAMETERS tcNetName
  LOCAL loWas, lnBufferPointer, lcServer, lcShare, lnRC, lcPathRest, loWas, lcLocalPath

  IF EMPTY(tcNetName) OR TYPE("tcNetName") <> "C"
    ERROR 11
  ENDIF

  DECLARE Long NetShareGetInfo IN Netapi32.dll ;
    String servername, String netname, Long level, Long @bufptr

  lcServer = STREXTRACT(tcNetName, "\\", "\")
  IF EMPTY(lcServer)
    RETURN ""
  ENDIF

  lcShare = STREXTRACT(tcNetName, "\\" + lcServer + "\", "\",1,1+2)
  lcPathRest = STREXTRACT(tcNetName, "\\" + lcServer + "\" + lcShare + "\", "",1,1)
  IF EMPTY(lcShare)
    RETURN ""
  ENDIF

  lnBufferPointer = 0
  lnRC = NetShareGetInfo(STRCONV(lcServer+CHR(0),5), ;
    STRCONV(lcShare+CHR(0),5), 2, @lnBufferPointer)
  IF lnRC = 0
    loWas = NEWOBJECT("WinApiSupport", "WinApiSupport.fxp")
    lcLocalPath = ADDBS(loWas.strzfrombufferw(lnBufferPointer + 24)) + lcPathRest
  ELSE
    lcLocalPath = Null
    _msgbox("Error accessing server '" + lcServer + "', share '" + lcShare + "'"  + CHR(13) + _apierror(lnRC))
  ENDIF
  *!* typedef struct _SHARE_INFO_2 {
  *!*  0 LPWSTR shi2_netname;
  *!*  4 DWORD shi2_type;
  *!*  8 LPWSTR shi2_remark;
  *!* 12 DWORD shi2_permissions;
  *!* 16 DWORD shi2_max_uses;
  *!* 20 DWORD shi2_current_uses;
  *!* 24 LPWSTR shi2_path;
  *!* 28 LPWSTR shi2_passwd;
  *!* } SHARE_INFO_2
  RETURN  lcLocalPath
ENDPROC
*----------------------------------------------------------------------------------

PROCEDURE _LocalName2UNC
  PARAMETERS tcLocalName
  LOCAL lcUNCBuffer, lnLength, lcLocalName
  DECLARE INTEGER WNetGetConnection IN WIN32API ;
    STRING @ lpLocalName, ;
    STRING @ lpRemoteName, ;
    INTEGER @ lplnLength

  IF EMPTY(tcLocalName) OR TYPE("tcLocalName") <> "C"
    ERROR 11
  ENDIF

  lcLocalName = ALLTRIM(tcLocalName)

  IF LEN(lcLocalName) = 1
    lcLocalName = lcLocalName + ":"
  ENDIF
  lcUNCBuffer = REPL(CHR(0),261)
  lnLength = LEN(lcUNCBuffer)
  IF WNetGetConnection(lcLocalName, @lcUNCBuffer, @lnLength) = 0
    lcRemoteName = LEFT(lcUNCBuffer,AT(CHR(0),lcUNCBuffer)-1)
  ELSE
    lcRemoteName = ""
  ENDIF

  RETURN lcRemoteName
ENDPROC
*----------------------------------------------------------------------------------

FUNCTION DeAllocNetAPIBuffer
  *
  * Frees the NetAPIBuffer allocated at the address specified by nPtr.
  * The API call is not supported under Win9x
  LPARAMETER tnBufferPointer
  DECLARE INTEGER NetApiBufferFree IN NETAPI32.DLL ;
    INTEGER lpBuffer
  RETURN (NetApiBufferFree(INT(tnBufferPointer)) = 0)
ENDFUNC
*----------------------------------------------------------------------------------

DEFINE CLASS WinApiSupport AS Custom

  * Converts VFP number to the Long integer
  FUNCTION Num2Long(tnNum)
    LOCAL lcStringl
    lcString = SPACE(4)
    =RtlPL2PS(@lcString, BITOR(tnNum,0), 4)
    RETURN lcString
  ENDFUNC

  * Convert Long integer into VFP numeric variable
  FUNCTION Long2Num(tcLong)
    LOCAL lnNum
    lnNum = 0
    = RtlS2PL(@lnNum, tcLong, 4)
    RETURN lnNum
  ENDFUNC

  *  Return Number from a pointer to DWORD
  FUNCTION Long2NumFromBuffer(tnPointer)
    LOCAL lnNum
    lnNum = 0
    = RtlP2PL(@lnNum, tnPointer, 4)
    RETURN lnNum
  ENDFUNC

  * Convert Short integer into VFP numeric variable
  FUNCTION Short2Num(tcLong)
    LOCAL lnNum
    lnNum = 0
    = RtlS2PL(@lnNum, tcLong, 2)
    RETURN lnNum
  ENDFUNC

  * Retrieve zero-terminated string from a buffer into VFP variable
  FUNCTION StrZFromBuffer(tnPointer)
    LOCAL lcStr, lnStrPointer
    lcStr = SPACE(4096)
    lnStrPointer = 0
    = RtlP2PL(@lnStrPointer, tnPointer, 4)
    lstrcpy(@lcStr, lnStrPointer)
    RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
  ENDFUNC

  *  Return a string from a pointer to LPWString (Unicode string)
  FUNCTION StrZFromBufferW(tnPointer)
    Local lcResult, lnStrPointer, lnSen
    lnStrPointer = This.Long2NumFromBuffer(tnPointer)

    lnSen = lstrlenW(lnStrPointer) * 2
    lcResult = Replicate(chr(0), lnSen)
    = RtlP2PS(@lcResult, lnStrPointer, lnSen)
    lcResult = StrConv(StrConv(lcResult, 6), 2)

    RETURN lcResult
  ENDFUNC

  * Retrieve zero-terminated string
  FUNCTION StrZCopy(tnPointer)
    LOCAL lcStr, lnStrPointer
    lcStr = SPACE(4096)
    lstrcpy(@lcStr, tnPointer)
    RETURN LEFT(lcStr, AT(CHR(0),lcStr)-1)
  ENDFUNC

ENDDEFINE
*------------------------------------------------------------------------
FUNCTION RtlPL2PS(tcDest, tnSrc, tnLen)
  DECLARE RtlMoveMemory IN WIN32API AS RtlPL2PS STRING @Dest, Long @Source, Long Length
  RETURN  RtlPL2PS(@tcDest, tnSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION RtlS2PL(tnDest, tcSrc, tnLen)
  DECLARE RtlMoveMemory IN WIN32API AS RtlS2PL Long @Dest, String Source, Long Length
  RETURN  RtlS2PL(@tnDest, @tcSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION RtlP2PL(tnDest, tnSrc, tnLen)
  DECLARE RtlMoveMemory IN WIN32API AS RtlP2PL Long @Dest, Long Source, Long Length
  RETURN  RtlP2PL(@tnDest, tnSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION RtlP2PS(tcDest, tnSrc, tnLen)
  DECLARE RtlMoveMemory IN WIN32API AS RtlP2PS STRING @Dest, Long Source, Long Length
  RETURN  RtlP2PS(@tcDest, tnSrc, tnLen)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION lstrcpy (tcDest, tnSrc)
  DECLARE lstrcpy IN WIN32API STRING @lpstring1, INTEGER lpstring2
  RETURN  lstrcpy (@tcDest, tnSrc)
ENDFUNC
*------------------------------------------------------------------------
FUNCTION lstrlenW(tnSrc)
  DECLARE Long lstrlenW IN WIN32API Long src
  RETURN  lstrlenW(tnSrc)
ENDFUNC
*------------------------------------------------------------------------

8 de marzo de 2016

Conversor de divisas utilizando la API de Google

? ConvertirDivisa(1, "USD", "ARS")  && 1 US Dolar -> Peso de Argentina 
? ConvertirDivisa(10, "EUR", "ARS")  && 10 Euros -> Peso de Argentina
? ConvertirDivisa(100, "ARS", "USD") && 100 Pesos de Argentina -> US Dolar

FUNCTION ConvertirDivisa(pnMonto, plFrom, plTo)
  LOCAL lc, lcUrl, la(1)
  DECLARE LONG URLDownloadToFile IN URLMON.DLL ;
    LONG, STRING, STRING, LONG, LONG
  ERASE "cambio.txt"
  lcURL = "https://www.google.com/finance/converter?a="+TRANSFORM(pnMonto)+"&from="+ plFROM +"&to=" + plTO
  IF 0 = URLDownloadToFile(0, lcURL, "cambio.txt", 0, 0)
    TRY
      INKEY(1)
      lc = FILETOSTR("cambio.txt")
      ALINES(la,lc,1,"<div id=currency_converter_result>")
      lc=la(2)
      ALINES(la,lc,1,"</span>")
      lc = STRTRAN(la(1),"<span class=bld>", "")
    CATCH
      lc =  "Error de divisas"
    ENDTRY
  ELSE
    lc =  "No hay conexion"
  ENDIF
  RETURN lc
ENDFUNC

Los códigos válidos de las distintas divisas están en la siguiente tabla:

5 de marzo de 2016

¿Qué tan vacio es un RecordSource vacio?

Artículo original: How empty is an empty RecordSource?
http://www.foxpert.com/knowlbits_200808_1.htm
Autor: Christof Wollenhaupt
Traducido por: Luis María Guayán


¿Puede un RecorSource estar vacio? ¿Estar vacio es lo mismo que vacio? ¿Son todos los RecordSource vacios iguales o algunos son mas vacios que otros? ¿Está mal una cuadrícula que no tiene un RecorSource? Preguntas y mas preguntas ...

... y no es fácil seguramente. La cuadrícula distingue el valor vacio que tiene por omisión y una cadena vacia especificada como valor de RecordSource.

Lo segundo significa precisamente eso. El RecordSource es desconocido, vacio, no especificado, no disponible. No sabiendo que hacer, la cuadrícula solo se muestra, literalmente, en blanco.

Lo primero, dejando la cuadrícula con el valor por omisión, da la oportunidad a la cuadrícula de demostrar lo inteligente que es. Ya sea de que se olvido de especificar un RecordSource o si obvió totalmente el RecordSource que desea que la cuadrícula utilice, ésta usa por omisión, el cursor en el área de trabajo actual.

Si esto es lo que quiere, esto está bien, sin embargo, si se crea un índice en el RecordSource, especifica un filtro, y asume que puede utilizar un código como este:

IF NOT EMPTY(This.RecordSource)
  SET FILTER TO AlgunaCondicion IN (This.RecordSource)
ENDIF

Ud. está tan equivocado como yo cuando tropecé con este comportamiento en Visual FoxPro. Si quiere un RecordSource vacio use = "" para el valor de la propiedad en el formulario, en caso contrario, especifique un alias válido. Pero no deje la propiedad simplemente con su valor por omisión

2 de marzo de 2016

Generador de clave de acceso aleatoria con Visual FoxPro

Artículo original: VFP Random Password/Key Generator
http://www.sweetpotatosoftware.com/SPSBlog/PermaLink,guid,45765bed-849a-4988-853c-3cfd8759e4e9.aspx
Autor: Craig Boyd
Traducido por: Ana María Bisbé York


Hoy he estado trabajando en la sección sobre Encriptar / Desencriptar que presentaré en la Conferencia Southwest Fox (http://www.swfox.net) Y en lo que estoy con este tema, he pensado que sería bueno si existiera una forma sencilla para crear claves de acceso aleatorias de una determinada cantidad de bits para determinados algoritmos de encriptación.

Entonces, he decidido crear un generador en Visual FoxPro 9.0. Me tomó como 10 minutos desde el inicio hasta el final y brinda una forma para crear claves de acceso aleatorias de forma bastante decente.

He aquí el enlace para la descarga y una imagen de la pantalla de ejemplo.

Descarga del ejemplo del Generador de Clave de acceso y código fuente (29 KB approx.)
vfppasskey.zip