Codigo Util

De ClarionWiki

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

Tabla de contenidos

[editar]

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 (Evolution)

[editar]

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 (Evolution)


[editar]

Crear directorios

Hay 2 opciones

1- Con Clarion (no se si estaran 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 podes poner lo siguiente: 

Var='O:\test'      ! Ojo tiene que ser Cstring
IF DirAccess(Var)<>0        !Si no existe
         MkDir(Var)                    !Crearlo
END

Tambien se puede usar DirRename y RmDir para renombrar o borrar

Fernando Cerini (Evolution)

[editar]

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



[editar]

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

[editar]

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


[editar]

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.


[editar]

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
[editar]

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
[editar]

Cerrar todas las ventanas abiertas 

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

Fernando Cerini (Evolution)

[editar]

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 (Evolution)

[editar]

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.evolutionconsulting.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 (Evolution)


[editar]

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 (Evolution)

[editar]

Convertir un string binario a LONG

Para volver del CSTRING al LONG seria simplemente 

X# = EVALUATE (binario & 'b')

Fernando Cerini (Evolution)

[editar]

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 (Evolution)

[editar]

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 (Evolution)

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

[editar]

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 (Evolution)

[editar]

Calcular Dias Habiles

Ante todo necesitas una tabla de feriados, con al menos un campo llamado, por ej., diaferiado y una clave por dicho campo.

Luego podes 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 calculos que vas a realizar son muchos y continuos, sería conveniente que la tabla de feriados la cargas en una queue y realices las búsquedas sobre ella.

Adrian Gallegos - Mega Sistemas S.R.L.

[editar]

Ultimo dia del mes y cantidad de dias (Lunes, Martes, etc) entre 2 Fechas

Incluye el truco de saber el ultimo dia del mes: en la parte " Date(4,1,2005)-1 " significa que le resto 1 al primer dia del mes siguiente, lo cual es una forma de obtener el ultimo dia 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 (Evolution)


[editar]

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 (Evolution) 

Dia" = Choose(((TODAY() % 7) + 1),'Domingo','Lunes','Martes','Miercoles','Jueves','Viernes','Sabado')

Javier A. Junca Barreto (SICyA Software - Colombia)

[editar]

Obtener la fecha del server

Este codigo 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 estas usando SQL o drivers ODBC, la otra opcion es preguntarle la fecha al motor de base de datos.

La forma generica 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 (Evolution)

[editar]

Llamar a un Stored Procedure

El codigo seria 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 ultimo SELECT que tenga el Stored Procedure.

Para mas detalles ver el documento sobre SQL Embebido (Evolution Downloads)

Tambien recomiendo leer el help "MSSQL Accelerator Calling a Stored Procedure". Ahi esta explicado ademas el uso de valores de retorno y parametros de salida.

Fernando Cerini (Evolution)

[editar]

Encriptacion basica

Encriptacion / desencriptacion basica 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 (Evolution)

[editar]

Generar un archivo de Texto a maxima velocidad

Estas son las APIs para generar un archivo de texto sin necesidad de declararlo en el Diccionario.

Ademas es muy rapido, 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 (Evolution)

[editar]

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 (Evolution)

[editar]

FUNCION PARA CALCULAR DIGITO 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

[editar]

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 (Evolution)

[editar]

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 (Evolution)

[editar]

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)

[editar]

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)

[editar]

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 Evolution Consulting

Obtenido de "http://www.dasu.com.ar/clarionwiki/index.php?title=Codigo_Util"
Herramientas personales