jueves, 8 de marzo de 2018

Código útil De ClarionWiki

Código útil

De ClarionWiki

En esta sección se incluyen rutinas de código que nos resultaron útiles en más de una ocasión.

Contenido

 
  1. Como filtrar un Tree
  2. Reemplazar caracteres en un string
  3. Contar los threads abiertos
  4. Permitir solo una instancia del EXE en ejecución
  5. Cambiar los atributos de un archivo
  6. Crear directorios
  7. Modificar la posicion de un informe
  8. Generar un informe a partir de una cola en memoria
  9. Proceso BATCH que funcione sincronizado con el TIMER de la ventana.
  10. Drop Combo a mano, con opción a todos y recuerdo de último elegido
  11. En un report, poner los totales en otra página
  12. En un report, cambiar el color de un campo según alguna condición
  13. Cerrar todas las ventanas abiertas
  14. Abrir cualquier archivo con ShellExecute
  15. Abrir una pagina WEB con ShellExecute
  16. Convertir un LONG a un String Binario
  17. Convertir un string binario a LONG
  18. Copiar la QUEUE (solo lo que se esta viendo) de un browse a Excel
  19. Copiar el VIEW (cuidado: se lee todo) de un browse a Excel
  20. Mostrar iconos en un listbox desde una queue
  21. Calcular Días Hábiles
  22. Último día del mes y cantidad de días (Lunes, Martes, etc) entre 2 Fechas
  23. Fecha en Español (por ejemplo en el Frame)
  24. Obtener la fecha del server
  25. Llamar a un Stored Procedure
  26. Encriptación básica
  27. Generar un archivo de Texto a máxima velocidad
  28. Efecto BLINK en un campo
  29. Función para calcular dígito verificador en CUIT
  30. Validar Email
  31. Restar Horas
  32. Digito Verificador para 5 dígitos
  33. Digito Verificador para Cualquier Longitud
  34. Autoincremento Manual
  35. Deshabilitar menu desde cualquier procedimiento
  36. Formatear fechas en SQL
  37. Anular Tecla Escape
  38. Convertir Número Hexadecimal a Binario
  39. Transacciones, TCF, Logout, Commit, Rollback

Como filtrar un Tree

Una tecnica de Saul Perez Quezada para filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter().
Alguien ha posteado una pregunta sobre como Filtrar arboles, yo en lo personal he dejado de usar arboles, por que son bastante lentos y deficientes, pero en algunas aplicaciones es bastante util, de manera que comparto la experiencia y les subo una pequeña explicacion de como filtrar Arboles (generados con el template Relacion Tree), con filtros en runtime que son complejos, y que no podemos hacer con un simple SetFilter(), ya que no existe esto en la propiedad.
Saludos y espero les sirva.
Como filtrar un Tree con solamente tablas:
Dentro del Template para armar los arboles, tiene dentro de Primary y Secondary files la opcion de filtrar, agregando un filtro, pero muchas veces dicho filtro no es tan simple de armar, o necesitamos estarlo cambiando en runtime.
Aqui les presento un caso y como su solucion, esperando que les sirva...
Tengo tres tablas:
Abuelos Padres Hijos
Y en la tabla hijos, tengo un campo que define en que nivel de escuela en que va cada hijo: Pre-escolar, Primaria, Secundaria, Bachillerato, Universidad, PostGrado, Maestria y Doctorado.
En la ventana requiero que el usuario pueda filtrar por el nivel escolar, pero con las siguientes condiciones:
1.- El usuario puede seleccionar si quiere ver cualquier combinacion de estudios, es decir, que pueda ver los de primaria y universidad solamente o todos, o ninguno... 2.- Si selecciona un filtro donde resulte que un abuelo o padre no tiene hijos que cumplan la condicion, entonces no debe mostrarnos a esos abuelos y padres...
Considerando que el Tree template, muestra siempre los niveles de acuerdo al filtro que se arma, pues podria convertirse algo engorroso, estar cambiando el filtro, ya que no es una propiedad del relacion tree, tal como sucede con el browse class, sino que el tree filtra a base de If's interpuestos al llenar el queue...
Usando el template y solo poniendo los filtros de NIVELESCOLAR = LOC:MINIVEL, solo mostraria los hijos de un nivel, asi que este metodo no nos servira...
La idea seria entonces que como filtro usaremos una condicion matematica, si la condicion es Verdadera, entonces mostrara el hijo, de lo contrario no lo mostrara.
Asi que con el comando EVALUATE, evaluaremos un filtro, dentro del secondary files, opcion filter, si el filtro es bueno (igual a 1), entonces nos mostrara la info de lo contrario no...
Por ejemplo:
En el secondary files en buscamos la tabla de Hijos y le escribimos en el filtro:
0<EVALUATE(Filtro) ! Si el filtro es valido, entonces nos mostrara el resultado, de lo contrario no...
Declaramos un check box por cada cada condicion, con su respectiva variable: Preescolar, Primaria, Secundaria, etc... que sea tipo byte, con valor true = 1 y valor false = 0
! En el acepted del check box Preescolar... y cada condicion... Do Filtrar Display
! En procedure routines Filtrar Routine 
 Clear(Filtro) ! Variable para filtrar

 If Preescolar Then Filtro = 'HIJ:NIVELESCOLAR=Preescolar' ..
 
 If Filtro And Primaria
   Filtro = Clip(Filtro) & ' And HIJ:NIVELESCOLAR=Primaria'
 ElsIf Filtro And Primaria
   Filtro = 'HIJ:NIVELESCOLAR=Primaria'
 End
 ! Esto se repite con todas las condiciones...
 ...
 ...
 
 ! Despues de armar el filtro, refrescar el browse...

 DO REL4::RefreshTree ! Esta rutina la genera el template, se debe buscar en los modulos su nombre correcto.
 POST(EVENT:NewSelection,?RelTree)

Exit
Hasta ahora, lo que se ha logrado es que cuando el usuario seleccione un tipo nivel escolar, nos mostrara o no los hijos, pero resulta, que ahora lo que necesito es que solo me muestre los abuelos que tienen nietos, y los padres que tienen hijos, es entonces por que no tiene caso que el arbol se llene con Mil abuelos, si solo 30 de ellos tienen nietos...
Para hacer debemos entender como se llena el queue del tree, basicamente, el tree, tantas vueltas como combinaciones de nuestra estructura tengamos, es decir, suponiendo que tenemos 3 abuelos, 3 padres, con 3 hijos cada uno, lo que hace el template es:
Por cada Abuelo Barre (con Loop) la tabla Padres por completo 1 vez y selecciono los que me corresponden y por cada padre barro la tabla hijos (con Loop) por completo y selecciono los que me corresponden...
Entonces esta estructura daria 3 x 3 x 3 = 27 vueltas. (Ahora imaginen lo que tarda en entre tablas de 10000 registros...)
Bueno, siguiendo esta idea, entonces lo que necesitamos, es interceptar cada vuelta en el punto donde no queremos que se ingrese al queue y hacer un break.
Conociendo esto buscamos en nuestros embeds, embedido llamado:
RelacionTree After Next Primary File y RelationTree After Next Secondary File...
Aqui buscamos el archivo que requerimos excluir en algunos casos, que es Padres e Hijos, le escribimos en el caso de Padres:
PAD:AbueloId = ABU:AbueloId If Access:Padres.Fetch(FK AbueloId)  ! Si no existen padres que sean dependientes de este abuelo 
 Break          ! hacer el break al Loop del armado del tree...
End
Y el caso de los hijos repetimos la condicion:
HIJ:PadreId = PAD:PadreId If Access:Hijos.Fetch(FK PadreId)  ! Si no existen hijos que sean dependientes de este abuelo 
 Break          ! hacer el break al Loop del armado del tree...
End
El efecto sera que no nos mostrara aquellos padres y abuelos que no tengan hijos.
Si requerimos algo mas complejo podemos usar una vista, en vez de una Fetch a una tabla, pero obviamente se alentara esto cada vez mas y mas al llenar el Arbol.
Nota Si usamos un motor de SQL, una alternativa mucho mas eficiente es declarar un Vista en nuestro motor y diccionario que sirva de base para llenar el Arbol, con esto aumentaria considerablemente la velocidad.

Reemplazar caracteres en un string

Una rutina generica para reemplazar todas las instancias de un string dentro de otro 
Replace       PROCEDURE(string find,string replace,*cstring into)
Locate LONG,AUTO
 CODE
   IF UPPER(find)<>UPPER(replace)
      LOOP
        Locate = INSTRING(UPPER(find),UPPER(into),1,1)
        IF ~Locate THEN RETURN .
        into = SUB(into,1,Locate-1) & replace &SUB(into,Locate+LEN(find),LEN(into))
      END
   END
Para llamarlo:
Replace('Busacr','Reemplazar',Loc:miString)
Fernando Cerini

Contar los threads abiertos

Este código fue posteado por Jeff Slarve 
ChildThreadCount Procedure!,Long
Ndx   Long
Count Long
T     &Window
W     &Window
 Code

 Count = 0
 SetTarget
 T &= System{PROP:Target}
 Loop Ndx = 1 to MaxThreads
    SetTarget(,Ndx)
    W &= System{PROP:Target}
    If NOT W &= T
      Count += 1
    end
 end
 SetTarget
 Return Count

Permitir solo una instancia del EXE en ejecucion

En Inside the global map: 
INCLUDE('CWUTIL.INC'),ONCE
En Global Program Setup: 
IF NOT BeginUnique('MiAPP.exe')
   BEEP(BEEP:SystemExclamation)
   YIELD()
   CASE MESSAGE('El programa ya esta ejecutando..','Ho, ho...',ICON:Asterisk,BUTTON:OK,BUTTON:OK,0)
   OF BUTTON:OK
      HALT()
   END
END
Fernando Cerini

Cambiar los atributos de un archivo

(Del FAQ de SoftVelocity) 1. En Global Embeds
A. Before Global Includes: 
LPCSTR EQUATE(CSTRING)
DWORD EQUATE(ULONG)
B. Global Data: Equates de los artributos 
FILE_ATTRIBUTE_READONLY EQUATE(00000001h)
FILE_ATTRIBUTE_HIDDEN EQUATE(00000002h)
FILE_ATTRIBUTE_SYSTEM EQUATE(00000004h)
FILE_ATTRIBUTE_ARCHIVE EQUATE(00000020h)
FILE_ATTRIBUTE_NORMAL EQUATE(00000080h)
FILE_ATTRIBUTE_TEMPORARY EQUATE(00000100h)
C. Inside Global Map: 
Module('Win32.lib')
SetFileAttributes(*CSTRING, ULONG), BOOL, RAW, PASCAL, NAME('SetFileAttributesA')
GetFileAttributes(*CSTRING), ULONG, RAW, PASCAL, NAME('GetFileAttributesA')
END
2. En el codigo: 
filename CSTRING(50)

filename = 'test.txt'
y# = GetFileAttributes(filename) ! Leer atributos
y# = SetFileAttributes(filename, FILE_ATTRIBUTE_READONLY)
Fernando Cerini

Crear directorios

Hay 2 opciones:
1- Con Clarion (no sé si estarán estas funciones en versiones anteriores de Clarion)
En "Inside the Global map" 
Include('clib.clw')
En Local Data 
MiDir Cstring(256)
Ret     Long
En tu embed 
MiDir = 'Dirtest'
Ret = MkDir(MiDir)
2- Con API En Global Embeds - inside global map: 
MODULE()
 DirAccess(*CSTRING,SHORT=0),SHORT,RAW,NAME('_access'),PROC
 MkDir(*CSTRING),SHORT,RAW,NAME('_mkdir'),PROC
 DirRename(*CSTRING, *CSTRING), SHORT, RAW, NAME('_rename'),PROC
 RmDir(*CSTRING),SHORT,RAW,NAME('_rmdir'),PROC
END
Y en tu embebido podés poner lo siguiente: 
Var='O:\test'      ! Ojo tiene que ser Cstring
IF DirAccess(Var)<>0        !Si no existe
         MkDir(Var)                    !Crearlo
END
También se puede usar DirRename y RmDir para renombrar o borrar
Fernando Cerini

Modificar la posicion de un informe

Este código permite modificar la posición inicial vertical y horizontal de un informe. Es útil cuando trabajamos con un formulario preimpreso o una hoja membretada y necesitamos desplazar la impresión sin necesidad de reconfigurar el programa.
El punto embebido donde se ubica es After Open the Report. 
!=====================================================
! MODIFICAR LA POSICION DEL INFORME
! El pie de página modificarlo sólo si se usa: 
! Por ejemplo se pone ahí el Nro de página o algo así.
! No es necesario cambiar los atributos de las bandas 
! de detalle adicionales que se usan en el informe.
!-----------------------------------------------------
DesplazamientoX =  getini('Parametros',|
                   'DesplazamientoX',,'.\prog.ini')
DesplazamientoY = getini('Parametros',|
                   'DesplazamientoY',,'.\prog.ini')

if DesplazamientoX or DesplazamientoY then
   SETTARGET(Report)
   x# = report{prop:Xpos}
   y# = report{prop:Ypos}
   x# += DesplazamientoX
   y# += DesplazamientoY
   target{prop:Xpos} = x#
   target{prop:Ypos} = y#
   settarget

   SETTARGET(Report,?Encabezado)
   x# = ?Encabezado{prop:Xpos}
   y# = ?Encabezado{prop:Ypos}
   x# += DesplazamientoX
   y# += DesplazamientoY
   ?Encabezado{prop:Xpos} = x#
   ?Encabezado{prop:Ypos} = y#
   settarget

   SETTARGET(Report,?PiePagina)
   x# = ?PiePagina{prop:Xpos}
   y# = ?PiePagina{prop:Ypos}
   x# += DesplazamientoX
   y# += DesplazamientoY
   ?PiePagina{prop:Xpos} = x#
   ?PiePagina{prop:Ypos} = y#
   SETTARGET
end


Generar un informe a partir de una cola en memoria

(Sin pasar por el template)
Se puede definir en el módulo en la parte de DATA el reporte necesario y mandarlo a imprimir.
En DATA SECTION 
WMFQue        QUEUE
PageImage       STRING(64)
              END
ReportRunDate LONG
ReportRunTime LONG
!!> Report (portrait) 
Report  REPORT,AT(1000,2000,6000,7000),THOUS,PRE(RPT),FONT('Arial',10)
        HEADER,AT(1000,1000,6000,1000)
        END
Detail   DETAIL
        END
        FOOTER,AT(1000,9000,6000,1000)
        END
        FORM,AT(1000,1000,6000,9000)
        END
      END

Luego, en el botón que imprime, poner el siguiente código: 
ReportRunDate = today()
ReportRunDate = today()
ReportRunTime = clock()
OPEN(Report)
LOOP x# = 1 to records(ColaError)
   get(ColaError,x#)
   PRINT(rpt:DetalleUno)
END
ENDPAGE(Report)
ReportPreview(WMFQue)
IF GlobalResponse = RequestCompleted
   Report{PROP:FlushPreview} = True
END
CLOSE(Report)
FREE(WMFQue)
Este proceso usa el Print Preview de Clarion para visualizar el informe, por consiguiente, la apariencia es totalmente normal para el usuario

Proceso BATCH que funcione sincronizado con el TIMER de la ventana.

En un proceso BATCH hecho a mano se puede operar en forma similar al report o al proccess, para eso hay que definir una pantalla que tenga el atributo TIMER (un valor de 1 es suficiente). El código fuente quedaría de la siguiente manera: 
open(PantaTrabaja)
Accept
case event()
  of event:openwindow
     Display()
     ! Abrir pantalla, Abrir archivos, hacer el set 
     ! Inicial
  of event:timer
     ?Mensaje{prop:text} = 'Procesando...'
     display(?Mensaje)
     loop 2 times
        next(archivo)
        if errorcode() then 
           FinArchivo = true
           Break
        end
        ! HACER AQUÍ ALGÚN PROCESO..
     end
  of event:closewindow
     Setcursor()
     Close(PantaTrabaja)
     Break
  End!case

case field()
  of ?BotonCancelar
     if event() = event:accepted then
        message('Proceso cancelado por el usuario.')
        post(event:closewindow)
     end
  End
end!accept

Drop Combo a mano, con opción a todos y recuerdo de último elegido

En muchos de mis informes, cuando pido parámetros asumo lo siguiente, por ejemplo: Si el código de cliente es igual a 0 (cero) se imprimen todos los clientes, sino, se imprime uno solo. Este código permite armar lo mismo con un DropCombo, agregando la opción TODOS LOS XXXX (código Cero).
1. Definir una cola con la siguiente estructura ( por ejemplo ): 
Cola     QUEUE,PRE(col)
descri     STRING(20)
codigo     SHORT
         END
2. Definir una variable local llamada por ejemplo 
Combo1     STRING(20)
3. En la pantalla definir una drop combo a mano, en el campo FROM poner el nombre de la COLA, y en el USE poner Combo1 ( no poner ?Combo1 )
4. Cargar la cola según corresponda después de abrir archivos, poniendo como último dato el código 0 y el texto 'TODOS LOS REGISTROS' y hacer un ADD(Cola,1) para que quede al principio.
5. Definir una variable global ( o local estática) que va a guardar el resultado elegido: 
Glo:codigo    short
6. En el evento open window, ANTES de abrir la ventana va el siguiente código 
loop x# = 1 to records(Cola)
  get(Cola,x#)
  if col:codigo = glo:codigo then break.
end
Combo1 = col:descri
?Combo1{prop:selected} = x#
7. Al hacer esto, el combo se abre posicionado en el último elemento elegido o en TODOS LOS REGISTROS si es la primera vez.

En un report, poner los totales en otra página

En algún informe, se puede solicitar como parámetro la opción de imprimir los totales correspondientes en una página nueva. Para ello, después de abrir el report: 

if glo:totpag then
   settarget(report)
   ?TituloTotalCategoria{prop:pagebefore} = 1
end

En un report, cambiar el color de un campo según alguna condición

Si durante la impresión de un informe se desea cambiar algún atributo (tal como el color) de un campo puede hacer lo siguiente (antes de imprimir el detalle): 
if cl:impotota <> cl:totacalc
   settarget(report)
   ?ARC:importe{PROP:FONTCOLOR} = COLOR:RED
   settarget(ProgressWindow)
else
   settarget(report)
   ?ARC:importe{PROP:FONTCOLOR} = COLOR:NONE
   settarget(ProgressWindow)
end
print(rpt:Detalle)  ! Imprimir la línea de detalle

Cerrar todas las ventanas abiertas

LOOP Thrd# = 2 TO 64 !1 es el Frame
    POST(Event:CloseWindow,,Thrd#)
END
Fernando Cerini

Abrir cualquier archivo con ShellExecute

Hay varios templates gratis que implementan Shellexecute, por ejemplo: http://www.sterlingdata.com/shellex.htm
Para hacerlo con codigo:
En Global-embed 'Inside the Global Map': 
Module('Win32.lib')
ShellExecute(Long,*CString,*CString,*CString,*CString,Short),UShort,PASCAL,RAW,NAME('ShellExecuteA')
END
En Local Data 
LOC:Handle LONG
LOC:Op     CSTRING (255)
LOC:File   CSTRING (255)
LOC:Path   CSTRING (255)
LOC:Param  CSTRING (255)
LOC:Show   LONG
LOC:RetHandle LONG
En el embed 
LOC:Handle = 0{PROP:Handle}
LOC:Op     = 'Open'
LOC:File   = 'C:\TEST.TXT'
LOC:Path   = PATH()
LOC:Param  = ' '
LOC:Show   = 1
LOC:RetHandle =  ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)
If LOC:Rethandle <> 0 Then
  Message('Error','Error',Icon:Exclamation)
End
Fernando Cerini

Abrir una pagina WEB con ShellExecute

(Ver declaraciones del API y variables en el ejemplo anterior)
En el embed 
LOC:Handle = 0{PROP:Handle}
LOC:Op     = 'Open'
LOC:File   = 'http://www.templatesclarion.com.ar'
LOC:Path   = ' '
LOC:Param  = ' '
LOC:Show   = 1
LOC:RetHandle = ShellExecute(LOC:Handle,LOC:Op,LOC:File,LOC:Param,LOC:Path,LOC:Show)
Fernando Cerini

Convertir un LONG a un String Binario

binario= !binario es CSTRING
LOOP F# = 1 TO 32
   IF BAND(abinario, 1) !abinario es LONG
       binario =  '1' & binario
   ELSE
       binario = '0' & binario
   END
   abinario = abinario / 2
   if abinario = 0 then break.
END
Fernando Cerini

Convertir un string binario a LONG

Para volver del CSTRING al LONG seria simplemente 
X# = EVALUATE (binario & 'b')
Fernando Cerini

Copiar la QUEUE (solo lo que se esta viendo) de un browse a Excel

Copiar= !Cstring de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
!Primero una fila con los titulos
    Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

LOOP F# = 1 TO RECORDS(BRW1.Q)
   LOOP C#= 1 TO BRW1.View{Prop:Fields}
       GET(BRW1.Q, F#)
       Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
   END
   Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)
Fernando Cerini

Copiar el VIEW (cuidado: se lee todo) de un browse a Excel

Copiar= !CSTRNG de 4.000.000
LOOP C#= 1 TO BRW1.View{Prop:Fields}
    Copiar= Copiar & ?Browse:1{PropList:Header,C#} & '<9>'
END
Copiar= Copiar &'<13,10>'

SET (BRW1.View)
LOOP
   NEXT(BRW1.View)
   IF ERRORCODE() THEN BREAK.
   BRW1.SetQueueRecord
   LOOP C#= 1 TO BRW1.View{Prop:Fields}
       Copiar= Copiar & FORMAT(WHAT(BRW1.Q, C#), ?Browse:1{PropList:Picture,C#}) & '<9>'
   END
   Copiar= Copiar &'<13,10>'
END
SETCLIPBOARD(Copiar)
Fernando Cerini
Para que no lea todo el contenido del archivo, sino que procese estrictamente lo mismo que muestra el browse, basta con agregar la antes del BRW1.SetQueueRecord el llamado a BRW1.ValidateRecord(). 
 ...
 LOOP
   NEXT(BRW1.View)
   IF ERRORCODE() THEN BREAK.
   IF BRW1.ValidateRecord() THEN CYCLE.
   BRW1.SetQueueRecrod
 ...
Daniel Ruzo

Mostrar iconos en un listbox desde una queue

Ejemplo: marcar en una cola de memoria si un empleado tiene entrada y/o salida
Primero agregar los iconos al Project
En el Codigo: 
cola_empleados    queue, pre(que)
nombre        string(30)
entro          long
entro_ico    long
salio          long
salio_ico    long
                        end
En el list:
primer campo: nombre
segundo campo: entro, picture @p p, iconized, transparente
tercer campo: salio, picture @p p, iconized, transparente
En el init de la pantalla: 
?list{prop:iconlist,1} = '~no.ico'
?list{prop:iconlist,2} = '~si.ico'
Donde cargo la cola y la muestro: 
if condicion  (si NO hay entrada)
    que:entro_ico = 1    ! icono de no
else
    que:entro_ico = 2    !icono de si
end
if condicion  (si NO hay salida)
    que:salio_ico = 1    ! icono de no
else
    que:salio_ico = 2    !icono de si
end
! otras asignaciones
add(cola_empleados)
!
display(?list)
Fernando Cerini

Calcular Días Hábiles

Ante todo necesitas una tabla de feriados, con al menos un campo llamado, por ej., diaferiado y una clave por dicho campo.
Luego podés hacer lo siguiente 
habiles# = 0
loop dia# = FechaInicial to FechaFinal
 if (Dia# % 7) = 0 then cycle. ! porque es domingo
 if (Dia# % 7) = 6 then cycle. ! porque es sabado
 !
 ! busco si es feriado
 !
 clear(feriado:record)
 feriado:diaferiado = dia#
 if access:feriado.fetch(Feriado:PorDia) = level:benign then cycle. !porque es feriado
 !
 habiles# += 1
end!loop
corridos# = fechafinal - fechainicial
Si los cálculos que vas a realizar son muchos y continuos, sería conveniente que la tabla de feriados la cargues en una queue y realices las búsquedas sobre ella.
Adrian Gallegos - Mega Sistemas S.R.L.
Otra opción: Días Hábiles del mes - Rutina que quita los días sábados y domingos del mes
CONTAR_DIAS ROUTINE 
   LOC:DIAS = 0
   tope# = 1
   LOOP UNTIL DAY(LOC:FECHA) = tope#
   CASE  LOC:FECHA % 7
     of  0   ! Domingo
      LOC:FECHA = LOC:FECHA - 1
      CYCLE
     of  6    ! sabado
      LOC:FECHA = LOC:FECHA - 1
      CYCLE
     ELSE
      LOC:DIAS += 1
      LOC:FECHA = LOC:FECHA - 1
    END !CASE
  END !LOOP
  IF  LOC:FECHA % 7 = 0 or  LOC:FECHA % 7 = 6 THEN  !si el primero es feriado
        ! nada
         else
        LOC:DIAS  += 1
  END !IF
Julio César Britez

Último día del mes y cantidad de días (Lunes, Martes, etc) entre 2 Fechas

Incluye el truco de saber el último día del mes: en la parte " Date(4,1,2005)-1 " significa que le resto 1 al primer día del mes siguiente, lo cual es una forma de obtener el último día del mes actual... 
Loop Fecha# = Date(3,1,2005) TO (Date(4,1,2005)-1)
   EXECUTE (Fecha# % 7) + 1
         Domingo# +=1
         Lunes# +=1
         Martes# +=1
         Miercoles# +=1
         Jueves# +=1
         Viernes# +=1
         Sabado# +=1
   END
END
Fernando Cerini

Fecha en Español (por ejemplo en el Frame)

Si quieres que funcione independientemente de como este configurado windows, lo mejor es poner este embed, al final de WindowManager.Init 
EXECUTE (TODAY() % 7) + 1
Dia"= 'Domingo'
Dia"= 'Lunes'
Dia"= 'Martes'
Dia"= 'Miercoles'
Dia"= 'Jueves'
Dia"= 'Viernes'
Dia"= 'Sabado'
END

EXECUTE (MONTH(TODAY()))
Mes" = 'Enero'
Mes" = 'Febrero'
Mes" = 'Marzo'
Mes" = 'Abril'
Mes" = 'Mayo'
Mes" = 'Junio'
Mes" = 'Julio'
Mes" = 'Agosto'
Mes" = 'Septiembre'
Mes" = 'Octubre'
Mes" = 'Noviembre'
Mes" = 'Diciembre'
END
AppFrame{Prop:StatusText,1} = CLIP(Dia") & ' ' & DAY(TODAY()) & ' de ' &
CLIP(Mes")

Fernando Cerini 
Dia" = Choose(((TODAY() % 7) + 1),'Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado')
Javier A. Junca Barreto (SICyA Software - Colombia)

Obtener la fecha del server

Este código lee la fecha del servidor, usando el truco de crear un archivo en el servidor y leer la fecha y hora de los atributos: 
!Data
LOC:TMP STRING(254),STATIC
TMP FILE,DRIVER('Ascii'),CREATE,NAME(LOC:TMP)
RECORD  RECORD
LIN STRING(1)
   .
   .
FILS   QUEUE(File:queue),PRE(FIL)
      END

CODE
 LOC:TMP = PATH()&'\TMP'&RANDOM(10000,99999)&'.TMP'
 CREATE(TMP)
 IF NOT ERRORCODE()
   DIRECTORY(FILS,LOC:TMP,0)
   REMOVE(TMP)
   GET(FILS,1)
   IF TODAY() <> FIL:DATE OR ABS(CLOCK()-FIL:TIME) > 100
!FECHA DIFERENTE O 1 SEGUNDO DE DESFASE
     SETTODAY(FIL:DATE)
     SETCLOCK(FIL:TIME)
   END
 ELSE
   REMOVE(TMP)
 END
Carlos Gutierrez
Con SQL
La sugerencia de Carlos es muy buena. Si estás usando SQL o drivers ODBC, la otra opción es preguntarle la fecha al motor de base de datos.
La forma genérica de hacerlo es: 
temp{prop:sql}='SELECT {fn curdate() }'
Con NET TIME
Posteado por Diego Sánchez al foro. 
Run('NET TIME \\Server_Name /SET /Y')
Reemplazar "Server_Name" por el nombre del servidor o equipo del cual se desea obtener la hora Fue posteado originalmente por un NICOLAS VEILLEUX nveilleux@nbautomation.com, en el foro comp.lang.clarion

Fernando Cerini

Llamar a un Stored Procedure

El código sería mas o menos asi: 
L:Query = 'CALL NombreDelStored ( & FORMAT(ParamFecha,@D12) & ,  &
FORMAT(OtraFecha,@D12) & , ' & OtroParam1 &', ' & OtroParam2 &', ' &
OtroParam3 &'  )'

ResSQL{prop:sql} = L:Query
Loop Until Access:ResSql.Next()
   MiVariable = R:Campo1
   etc     = R:Campo2
....
END
En la tabla auxiliar ResSQL obtienes el resultado del último SELECT que tenga el Stored Procedure.
Para mas detalles ver el documento sobre SQL Embebido (Templates Clarion)
También recomiendo leer el help "MSSQL Accelerator Calling a Stored Procedure". Ahi está explicado además el uso de valores de retorno y parámetros de salida.
Fernando Cerini

Encriptación básica

Encriptación / desencriptación básica de un campo usando el metodo XOR. 
!la primera vez encripta
!al volver a aplicar el algoritmo con la misma
!Clave de encriptado: desencripta
X# = 1
loop Y# = 1 to Len(Campo)
  Campo [Y#] = chr(bxor(val(Campo[Y#]), val(ClaveEncriptado[X#])))
  X# += 1
  if X# > len (ClaveEncriptado) then X# = 1.
end
display

!Campo y ClaveEncriptado son campos CString
Fernando Cerini

Generar un archivo de Texto a máxima velocidad

Estas son las APIs para generar un archivo de texto sin necesidad de declararlo en el Diccionario.
Además es muy rápido, ideal para exportaciones.
En Global - Inside Global map: 
MODULE('Windows API')
 _lcreat(*CSTRING,SIGNED),SIGNED,PASCAL,RAW
 _hwrite(SIGNED,*CSTRING,LONG),LONG,PASCAL,RAW
 _lclose(SIGNED),SIGNED,PASCAL
END

Por ejemplo para guardar el contenido de un control Text 
IF NOT FILEDIALOG('Guardar como',FileName,'Text|*.TXT|Source|*.CLW',FILE:Save + FILE:LongName)
   CYCLE
END
F# = _lcreat(FileName,0)
X# = _hwrite(F#,Texto,LEN(Texto))
X# = _lclose(F#)
Fernando Cerini

Efecto BLINK en un campo

Tienes que crear un timer en la ventana, para eso ponle cada cuanto se va a ejecutar en la propiedad timer de la ventana. Son centesimas de seg, asi que si le pones 50 por ejemplo tu campo va a titilar 2 veces por segundo.
Luego cierra la ventana, vuelve a entrar y vas a encontrar un evento timer de la ventana en los embeds.
Window Events --> Timer 
if ?campo{prop:background} = COLOR:WHITE
   ?campo{prop:background} = COLOR:SILVER
else
   ?campo{prop:background} = COLOR:WHITE
end
Fernando Cerini

Función para calcular dígito verificador en CUIT

- La siguiente función devuelve el numero de CUIT con el dígito verificador correcto. - El parámetro que recibe es el numero de CUIT a revisar incluyendo el dígito verificador. 
 ...
 CuitCliente='20-15433984-6'
 IF Cuit(CuitCliente)=CuitCliente THEN
   MESSAGE('Digito verificador correcto')
 ELSE
   MESSAGE('Digito verificador incorrecto')
 END
 ...

Cuit         PROCEDURE(cuit1)
cuit2        STRING(255)
digver       LONG
lon          LONG
fac          LONG
car          STRING(1)
  
 CODE
 cuit2=cuit1
 digver=0
 fac=2
 lon=LEN(CLIP(cuit2))
 LOOP i#=lon-1 TO 1 BY -1
   car=SUB(cuit2,i#,1)
   IF car<'0' OR car>'9' THEN
     CYCLE
   .
   digver=digver+(car*fac)
   fac+=1
   IF fac>7 THEN
     fac=2
   .
 .
 digver=11-(digver%11)
 IF digver>9 THEN
   digver=0
 .
 cuit2=SUB(cuit2,1,lon-1) & FORMAT(digver,@n01)
 RETURN(cuit2)
Este codigo esta en la documentacion del template de Impresoras Fiscales (BIGSYS TEMPLATES) del amigo Juan Carlos Rodríguez

Validar Email

Puedes hacerlo con MATCH, el cual devuelve 1 o 0 si el mail no es valido. Ejemplo: 
X# =  MATCH(UPPER(CLIP(locemail)),|
'^[-A-Z0-9._]+@{{[-A-Z0-9._]+.}+[A-Z][A-Z][A-Z]?[A-Z]?$', Match:Regular)
Fernando Cerini

Restar Horas

Para sacar la diferencia entre horas es simplemente: 
resultado = hora2  - hora + 1
El +1 es porque sino que faltaria un segundo cuando muestres el resultado (en formato @T6, por ej)
Si Hora2 es del dia siguiente, la cuenta seria: 
resultado = (hora2 +(100*60*60*24)) - hora + 1
Fernando Cerini

Digito Verificador para 5 digitos

Si tenes un numero de 5 digitos y deses verificar que el mismo es ingresado correctamente podes usar este codigo que genera un digito verificador
Crea una funcion que tenga un parametro (numero a verificar) y retorne el digito verificador correspondiente ejem: DigitoV5(LONG xNumero),BYTE 
 loc:Numero = xNumero

 loc:Valor = (loc:Numero[1]*5) + |
             (loc:Numero[2]*4) + |
             (loc:Numero[3]*3) + |
             (loc:Numero[4]*2) + |
             (loc:Numero[5]*7)

 IF (loc:Valor%5) + 1 = 0 OR (loc:Valor%5) + 1 = 1
   loc:Digito = 0
 ELSE
   loc:Digito = 6 - ((loc:Valor%5) + 1)
 END

 RETURN loc:Digito
Ruben Garcia (DiPS)

Digito Verificador para Cualquier Longitud

Si no sabes que longitud puede tener el numero a verificar podes probar verificarla con este codigo
Crea una funcion cuyo parametro es el numero a verificar y retorne el digito verificador. Ej. DigitoV(STRING xNumero),BYTE 
 !Inicializa
 loc:Numero   = xNumero
 loc:Valor    = 0
 loc:Multiplo = 1

 !Barrido y calculo
 LOOP loc:Posicion = LEN(CLIP(loc:Numero)) TO 1 BY -1
   loc:Multiplo += 1
   IF loc:Multiplo > 7
     loc:Multiplo = 2
   END
   loc:Valor += loc:Numero[loc:Posicion] * loc:Multiplo
 END

 loc:Digito = loc:Valor % 11

 IF loc:Digito = 10
   loc:Digito = 0
 END

 RETURN loc:Digito
Ruben Garcia (DiPS)

Autoincremento Manual

Esto se utiliza cuando tenemos una tabla en la cual queremos manejar la clave de auto incremento 
CLEAR(MASTER)
SET(MAS:ClavePorID, MAS:ClavePorID)
ACCES:MASTER.Previous()
IF MAS:Id = 0 THEN 
    MAS:Id = 1
ELSE 
    MAS:Id = MAS:Id +1 
END
!!!MAS:Id TENDRÍA EL VALOR DEL PROXIMO NUMERO.-
Gracias Fernando Cerini
Nota: El mecanismo descrito es "confiable" sólo para aplicaciones que usan TPS y en modo single-user. Para Multiusuario y SQL hay que tener cuidado con las lecturas simultáneas del último valor. También puede simplificarse el "if ... then ... else ..." como "MAS:Id = MAS:Id +1" (si es cero, será 1, no hace falta chequearlo)

Desabilitar menu desde cualquier procedimiento

Una opcion seria usando NOTIFY. En el Frame 
Window Events
   Notify
       DISABLE = VariableGlobal
En cualquier procedimiento que se necesite deshabilitar un menu 
VariableGlobal = Nro de Use del Menu
NOTIFY (999, 1)
Puede ser 999 o cualquier cosa ya que no estoy usando ese parametro. (bueno, en realidad podria usar ese parametro en lugar de la global...) 1 es el Tread del Frame
Como desde los otros procedimientos no existen los use del los items de menu (o sea ?menuitem) lo que hay que hacer es ponerles un numero a cada uno. Esto se logra poniendolos de esta manera ?use, numero en la definicion del menu.
Fernando Cerini

Formatear fechas en SQL

Les paso una función que utilizo para trabajar con las fechas en el SQL parecido al format de clarion. Es muy útil. 
 CREATE FUNCTION dbo.FormatDateTime
 (
     @dt DATETIME,
     @format VARCHAR(16)
 )
 RETURNS VARCHAR(64)
 AS
 BEGIN
     DECLARE @dtVC VARCHAR(64)
     SELECT @dtVC = CASE @format
 
     WHEN 'LONGDATE' THEN
 
         DATENAME(dw, @dt)
         + ',' + SPACE(1) + DATENAME(m, @dt)
         + SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
         + ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))
 
     WHEN 'LONGDATEANDTIME' THEN
 
         DATENAME(dw, @dt)
         + ',' + SPACE(1) + DATENAME(m, @dt)
         + SPACE(1) + CAST(DAY(@dt) AS VARCHAR(2))
         + ',' + SPACE(1) + CAST(YEAR(@dt) AS CHAR(4))
         + SPACE(1) + RIGHT(CONVERT(CHAR(20),
         @dt - CONVERT(DATETIME, CONVERT(CHAR(8),
         @dt, 112)), 22), 11)
 
     WHEN 'SHORTDATE' THEN
 
         LEFT(CONVERT(CHAR(19), @dt, 0), 11)
 
     WHEN 'SHORTDATEANDTIME' THEN
 
         REPLACE(REPLACE(CONVERT(CHAR(19), @dt, 0),
             'AM', ' AM'), 'PM', ' PM')
 
     WHEN 'UNIXTIMESTAMP' THEN
 
         CAST(DATEDIFF(SECOND, '19700101', @dt)
         AS VARCHAR(64))
 
     WHEN 'YYYYMMDD' THEN
 
         CONVERT(CHAR(8), @dt, 112)
 
     WHEN 'YYYY-MM-DD' THEN
 
         CONVERT(CHAR(10), @dt, 23)
 
     WHEN 'YYMMDD' THEN
 
         CONVERT(VARCHAR(8), @dt, 12)
 
     WHEN 'YY-MM-DD' THEN
 
         STUFF(STUFF(CONVERT(VARCHAR(8), @dt, 12),
         5, 0, '-'), 3, 0, '-')
 
     WHEN 'MMDDYY' THEN
 
         REPLACE(CONVERT(CHAR(8), @dt, 10), '-', SPACE(0))
 
     WHEN 'MM-DD-YY' THEN
 
         CONVERT(CHAR(8), @dt, 10)
 
     WHEN 'MM/DD/YY' THEN
 
         CONVERT(CHAR(8), @dt, 1)
 
     WHEN 'MM/DD/YYYY' THEN
 
         CONVERT(CHAR(10), @dt, 101)
 
     WHEN 'DDMMYY' THEN
 
         REPLACE(CONVERT(CHAR(8), @dt, 3), '/', SPACE(0))
 
     WHEN 'DD-MM-YY' THEN
 
         REPLACE(CONVERT(CHAR(8), @dt, 3), '/', '-')
 
     WHEN 'DD/MM/YY' THEN
 
         CONVERT(CHAR(8), @dt, 3)
 
     WHEN 'DD/MM/YYYY' THEN
 
         CONVERT(CHAR(10), @dt, 103)
 
     WHEN 'HH:MM:SS 24' THEN
 
         CONVERT(CHAR(8), @dt, 8)
 
     WHEN 'HH:MM 24' THEN
 
         LEFT(CONVERT(VARCHAR(8), @dt, 8), 5)
 
     WHEN 'HH:MM:SS 12' THEN
 
         LTRIM(RIGHT(CONVERT(VARCHAR(20), @dt, 22), 11))
 
     WHEN 'HH:MM 12' THEN
 
         LTRIM(SUBSTRING(CONVERT(
         VARCHAR(20), @dt, 22), 10, 5)
         + RIGHT(CONVERT(VARCHAR(20), @dt, 22), 3))
 
     ELSE
 
         'Invalid format specified'
 
     END
     RETURN @dtVC
 END
 GO
 
 
 Ejemplos:
 
 DECLARE @now DATETIME
 SET @now = GETDATE()
 
 PRINT dbo.FormatDateTime(@now, 'LONGDATE')
 PRINT dbo.FormatDateTime(@now, 'LONGDATEANDTIME')
 PRINT dbo.FormatDateTime(@now, 'SHORTDATE')
 PRINT dbo.FormatDateTime(@now, 'SHORTDATEANDTIME')
 PRINT dbo.FormatDateTime(@now, 'UNIXTIMESTAMP')
 PRINT dbo.FormatDateTime(@now, 'YYYYMMDD')
 PRINT dbo.FormatDateTime(@now, 'YYYY-MM-DD')
 PRINT dbo.FormatDateTime(@now, 'YYMMDD')
 PRINT dbo.FormatDateTime(@now, 'YY-MM-DD')
 PRINT dbo.FormatDateTime(@now, 'MMDDYY')
 PRINT dbo.FormatDateTime(@now, 'MM-DD-YY')
 PRINT dbo.FormatDateTime(@now, 'MM/DD/YY')
 PRINT dbo.FormatDateTime(@now, 'MM/DD/YYYY')
 PRINT dbo.FormatDateTime(@now, 'DDMMYY')
 PRINT dbo.FormatDateTime(@now, 'DD-MM-YY')
 PRINT dbo.FormatDateTime(@now, 'DD/MM/YY')
 PRINT dbo.FormatDateTime(@now, 'DD/MM/YYYY')
 PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 24')
 PRINT dbo.FormatDateTime(@now, 'HH:MM 24')
 PRINT dbo.FormatDateTime(@now, 'HH:MM:SS 12')
 PRINT dbo.FormatDateTime(@now, 'HH:MM 12')
 PRINT dbo.FormatDateTime(@now, 'goofy')
Posteado al foro por Omar Squiabro

Anular Tecla Escape

Hay veces que se necesita que el usuario salga de una FORM o de una ventana solo cuando pulse un determinado boton o se halla completado alguna condicion. Y en estos casos puede suceder que si el usuario pulsa la tecla ESC cause algun problema
Primero hay que activar la alerta de la tecla esc en el INIT de la ventana 
 ALERT(EscKey)
Despues en el evento alertkey 
 IF KEYCODE() = EscKey
   SELECT(?UnDeterminadoCampo)  !1= al primero
   RETURN Level:Notify          
 END
Si el codigo embebido es puesto despues del codigo generado por clarion reemplazar el RETURN por CYCLE
Ruben Garcia (DiPS)

Convertir Número Hexadecimal a Binario

A veces, y sobre todo al trabajar con estados de puertos de comunicaciones, necesitamos convertir numeros hexadecimales a binario para establecer errores o tratar envios y recepciones. Esta función hace justamente esto de forma sencilla. 
HexaABinario         PROCEDURE(PAR:Nhexa)   ! (String),String
HBinario   String(4),dim(16) !Equivalencias
RetuBina   String(100)       !Variable Retorno

 CODE
  HBinario[01] = '0000' !     0h
  HBinario[02] = '0001' !     1h
  HBinario[03] = '0010' !     2h
  HBinario[04] = '0011' !     3h
  HBinario[05] = '0100' !     4h
  HBinario[06] = '0101' !     5h 
  HBinario[07] = '0110' !     6h
  HBinario[08] = '0111' !     7h
  HBinario[09] = '1000' !     8h 
  HBinario[10] = '1001' !     9h
  HBinario[11] = '1010' !     Ah  65
  HBinario[12] = '1011' !     Bh  66
  HBinario[13] = '1100' !     Ch  67
  HBinario[14] = '1101' !     Dh  68
  HBinario[15] = '1110' !     Eh  69
  HBinario[16] = '1111' !     Fh  70
  CLEAR(RetuBina)
  PAR:NHexa = UPPER(PAR:NHexa) !Aseguro letras en mayusculas
  LOOP I# = 1 to LEN(CLIP(PAR:NHexa))
    IF NUMERIC(PAR:NHexa[I#]) THEN  !Si es numero es <= 9
       !Asigno equivalente
       RetuBina = CLIP(RetuBina) & HBinario[PAR:NHexa[I#]+1]
    ELSE
      !Asigno equivalente tomando,por ejemplo, 65 - 54 = 11 para "A"
       RetuBina = CLIP(RetuBina) & HBinario[VAL(PAR:NHexa[I#])-54]
    END
  END
  !Retorno la cadena binaria sin ceros a la izquierda
  RETURN(SUB(RetuBina, INSTRING('1',RetuBina), LEN(CLIP(RetuBina))))
Bueno, espero les sea de utilidad!
Mario A. Wojcik

Transacciones, TCF, Logout, Commit, Rollback

Solucion al tema del TCF, crearlo, verlo, etc.
Paso 1 En el punto embebido del FRAME (windowsManager init (priority 6100) o sea antes que se abra ningun archivo, Insertar el siguiente codigo: 
GLO:Datos:TCF =  'TCF=' & CLIP(GLO:WorkDir) & '\' & 'AR.TCF'
Send(CLIENTES,GLO:Datos:TCF)
Nota 1: No es necesario definir en ningun lado el archivo .TCF ni su estructura porque de todo se encarga el driver. Nota 2: no enviar (SEND) los datos para el .TCF desde el diccionario, según los autores, esto no funciona. Nota 3: Solo es necesario un archivo .TCF para toda la aplicación.
Listo, el archivo de control de transacciones ya esta creado y sin dudas funcionara. Para que todo quede completo deberiamos hacer: 
LOGOUT(1,CabeceraFactura,DetalleFactura) !Comienza la transaccion
DO ErrHandler     !Chequear errores
ADD(CabeceraFactura)    !Agregar registro al padre
DO ErrHandler     !
LOOP X# = 1 TO RECORDS(DetailQue)  !Procesar los registros almacenados
GET(DetailQue,X#)     !traer uno de la Cola
DO ErrHandler     !
Det:Record = DetailQue    !Asignar al record buffer
ADD(DetalleFactura)    !Hacer el Add al archivo
DO ErrHandler     !
END
COMMIT      !Terminar la transaccion, todo OK
ASSERT(~ERRORCODE())

ErrHandler ROUTINE     !Runina de manejo de errores
IF NOT ERRORCODE() THEN EXIT.   !Sale si no hay errores
Err" = ERROR()     !Guarda el mensaje de error
ROLLBACK      !Anula la transaccion
ASSERT(~ERRORCODE())
BEEP       !Avisa al usuario
MESSAGE('Transaction Error - ' & Err")
RETURN
Lo anterior es copia de la ayuda del manual de Clarion 6.3
Para verificar que exista realmente el archivo .TCF podemos usar en cualquier punto de la aplicación lo siguiente:
Poner un string variable en pantalla y en un boton:
Loc:Tcf = SEND(CLIENTES, 'TCF') DISPLAY() 
Eso deberia ser todo. Por lo menos para mi funciona.

Carlos Barroso
DBA Oracle
Programador Clarion
Publicadas por a la/s

No hay comentarios.:

Publicar un comentario

Suscribirse a: Comentarios de la entrada (Atom)