*------------------------------------------------------------
* EDITMEM.PRG - Programa para modificar archivos .MEM
*
* Autor: Julio César Mosquera - Claudio VOSKIAN
*
* Contenido:
*
* ADDVAR....: Agrega una variable al .MEM
* ADMIN.....: Administrar las funciones del programa
* CENTRAR ..: Centrar un texto
* CONFIRMA..: Pide la confirmación de una acción
* DELVAR....: Elimina una variable del .MEM
* LECMEM....: Lee el archivo .MEM y carga sus variables al vector
* MODVAR....: Modifica una variable del .MEM
* PRESS.....: Pone un mensaje en la última línea y espera una tecla
* VMEM......: Validación del nombre del archivo
* VNOMVAR...: Valida nombre de la variable
* VTIPVAR...: Valida el tipo de la variable
* VVALVAR...: Valida el contenido de la variable
*------------------------------------------------------------
*------------------------------------------------------------
* Rutina.......: EM.PRG
* Objetivo.....: Programa para modificar archivos .MEM
*------------------------------------------------------------
external LEFT,RIGHT,DESCEND,ALLTRIM,STRZERO
memvar x, y
*
function main(x, y)
*------------
local getlist := {}
private z_6_mem, z_6_salir, z_6_grabar, z_6_choice, z_6_nomvar, z_6_valvar,;
z_6_accion, z_6_inic, z_6_1, z_6_2, z_6_3, z_6_4, z_6_print, z_6_fila
set scoreboard off
set date british
set century on
set confirm on
set exact on
set fixed on
set decimals to 6
setmode(25,80)
m->z_6_print = "printer"
if valtype(x) # "C"
x = space(255)
else
if valtype(y) = "C"
x += y
endif
if "/P" $ upper(x)
set printer to printer.prn
m->z_6_print = "file"
x = alltrim(strtran(x, "/P", '', 1, 1))
endif
endif
m->z_6_mem = x
m->z_6_salir = .f.
m->z_6_inic = .t.
while !m->z_6_salir
private z_6_var // array(500)
private z_6_cvar
m->z_6_var := array(500)
clear screen
setcolor("W+")
centrar(0, 80, "Editor de .MEM")
setcolor("W/N")
if !empty(m->z_6_mem)
m->z_6_mem = upper(alltrim(m->z_6_mem))
if !file(m->z_6_mem)
if right(m->z_6_mem, 4) # ".MEM" .and. rat(".", m->z_6_mem) <= rat("\", m->z_6_mem)
m->z_6_mem = m->z_6_mem + ".MEM"
endif
endif
endif
@ 3, 0 say "Nombre del MEM a editar:"
if !m->z_6_inic .or. empty(m->z_6_mem)
m->z_6_mem = pad(m->z_6_mem, 128)
@ 3,25 get m->z_6_mem picture "@!S30" valid vmem()
m->z_6_salir = !doread(getlist)
else
@ 3,25 say m->z_6_mem
endif
m->z_6_inic = .f.
if !m->z_6_salir
admin()
endif
enddo
setcolor('')
set cursor on
clear screen
return nil
*
function vmem && validación del nombre del archivo
*------------
local ret, k
ret = .t.
if empty(m->z_6_mem)
press("Debe informar el nombre")
ret = .f.
else
k = alltrim(m->z_6_mem)
if !file(k)
if right(k, 4) # ".MEM" .and. !("." $ k)
k += ".MEM"
endif
endif
if file(k)
m->z_6_mem = k
else
press("Archivo inexistente")
ret = .f.
endif
endif
return ret
*
function admin && Administrar las funciones del programa
*-------------
lecmem()
if m->z_6_cvar > 0
restore from (m->z_6_mem) additive
m->z_6_1 = 5 && fila superior izquierda
m->z_6_2 = 5 && columna superior izquierda
m->z_6_3 = 14 && fila inferior derecha
m->z_6_4 = m->z_6_2 + 16 && columna superior derecha
setcolor("W+")
@ m->z_6_1 + 1, m->z_6_2 + 40 say "Agrega variable [INS]"
@ m->z_6_1 + 2, m->z_6_2 + 40 say "Elimina variable [DEL]"
@ m->z_6_1 + 3, m->z_6_2 + 40 say "Consulta/Modifica [ENTER]"
@ m->z_6_1 + 4, m->z_6_2 + 40 say "Graba .mem y sale [G]"
@ m->z_6_1 + 5, m->z_6_2 + 40 say "Sale sin grabar [ESC]"
@ m->z_6_1 + 6, m->z_6_2 + 40 say "Imprime [I]"
@ m->z_6_1 + 7, m->z_6_2 + 40 say "Copia variable [C]"
setcolor("W/N")
@ m->z_6_1, m->z_6_2 to m->z_6_3, m->z_6_4 double
setcolor("W+")
centrar(m->z_6_1, 13, " Variables ", m->z_6_2 + 2)
setcolor("W/N")
while .t.
@ m->z_6_1 + 1, m->z_6_2 + 1 clear to m->z_6_3 - 1, m->z_6_4 - 1
m->z_6_choice = achoice(m->z_6_1 + 1, m->z_6_2 + 2, m->z_6_3 - 1, m->z_6_4 - 2, m->z_6_var, .t., "fmenu", m->z_6_choice)
do case
case m->z_6_choice # 0 .and. m->z_6_accion = "M"
* modificar la variable
@ m->z_6_fila, m->z_6_2 - 2 say ">>"
modvar()
@ m->z_6_fila, m->z_6_2 - 2 say " "
case m->z_6_choice # 0 .and. m->z_6_accion = "C"
* copiar la variable
@ m->z_6_fila, m->z_6_2 - 2 say ">>"
if copvar()
&(m->z_6_nomvar) := m->z_6_valvar
press("Variable copiada")
endif
@ m->z_6_fila, m->z_6_2 - 2 say " "
case m->z_6_choice # 0 .and. m->z_6_accion = "D"
* eliminar la variable
@ m->z_6_fila, m->z_6_2 - 2 say ">>"
m->z_6_nomvar = LEFT(m->z_6_var[m->z_6_choice],10)
if confirma("la eliminación de " + trim(m->z_6_nomvar))
adel(m->z_6_var, m->z_6_choice)
m->z_6_cvar = m->z_6_cvar - 1
release &(m->z_6_nomvar)
endif
@ m->z_6_fila, m->z_6_2 - 2 say " "
case m->z_6_accion = "A"
* agrego la variable
&(m->z_6_nomvar) := iif(type("m->z_6_valvar") = "C", substr(m->z_6_valvar, 2, len(m->z_6_valvar) - 2), m->z_6_valvar)
m->z_6_choice = m->z_6_cvar
case m->z_6_accion = "G"
* grabar
save to (m->z_6_mem) all except z_6_*
EXIT
otherwise
* salida!
EXIT
endcase
enddo
endif
return .f.
*
function modvar && Modifica una variable
*--------------
local getlist := {}
local Pant := savescreen(0, 0, 24, 79)
private tipvar
private oldvar, valvar, oldtip, picvar
m->z_6_nomvar = space(10)
m->tipvar := " "
m->oldvar := LEFT(m->z_6_var[m->z_6_choice],10)
m->oldtip := m->tipvar := type(m->oldvar)
m->valvar := ''
@ 16, 1 say "Tipo anterior: " + m->tipvar
@ 17, 0 say "Valor anterior:"
if iif(type(m->oldvar) = "C", len(&(m->oldvar)) > 30, .f.)
@ 17, 16 say left(&(m->oldvar), 30)
setcolor("W+")
@ 17, 47 say ">> sigue >>"
setcolor("W")
else
@ 17, 16 say &(m->oldvar)
endif
@ 18, 4 say "Nuevo tipo:" get m->tipvar picture "@A!" valid vtipvar()
if doread(getlist)
@ 19, 3 say "Nuevo valor:" get m->valvar picture m->picvar valid vvalvar()
if m->tipvar = "C"
if m->valvar = '""'
keyboard chr(4)
readinsert(.t.)
endif
endif
if doread(getlist)
if type("m->valvar") = "C" && Saco comillas, si las hay!
m->valvar = trim(m->valvar)
if left(m->valvar,1) $ ["']
m->valvar = substr(m->valvar, 2, len(m->valvar) - 2)
endif
endif
&(m->oldvar) = m->valvar
m->z_6_var[m->z_6_choice] = LEFT( m->oldvar + SPACE(10), 10) + " " + type(m->oldvar)
endif
readinsert(.f.)
endif
restscreen(0, 0, 24, 79, Pant)
return .f.
*
function vtipvar && valida el tipo de la variable
*---------------
local ret
do case
case lastkey() = 5
ret = .t.
case empty(m->tipvar)
press("No puede ser vacío")
ret = .f.
case m->tipvar $ "CNDL"
ret = .t.
do case
case m->tipvar = "C"
if m->tipvar = m->oldtip
m->valvar = pad('"' + &(m->oldvar) + '"', 255)
else
m->valvar = '""' + space(253)
endif
m->picvar = "@S30"
case m->tipvar = "D"
if m->tipvar = m->oldtip
m->valvar = &(m->oldvar)
else
m->valvar = ctod('')
endif
m->picvar = ''
case m->tipvar = "L"
if m->tipvar = m->oldtip
m->valvar = &(m->oldvar)
else
m->valvar = .f.
endif
m->picvar = "L"
case m->tipvar = "N"
if m->tipvar = m->oldtip
m->valvar = &(m->oldvar)
else
m->valvar = 0
endif
m->picvar = "99999999999.999999"
endcase
otherwise
press("Debe ser C, N, D o L")
ret = .f.
endcase
return ret
*
function vvalvar && Valida el contenido de la variable
*---------------
local ret, k, h
if lastkey() = 5
ret = .t.
elseif m->tipvar = "C"
k = alltrim(m->valvar)
if empty(k)
ret = .f.
press("Debe incluir comillas")
else
h = left(k, 1)
if h = "&"
H = SUBSTR(K, 2)
m->VALVAR = &H
if type("m->VALVAR") = "C"
* if empty(m->valvar)
m->valvar = '"' + m->valvar + '"'
* endif
endif
RET = .T.
ELSE
if !h $ ["']
press("Debe comenzar con comillas o '&'")
ret = .f.
else
if right(k, 1) = h .and. !(h $ substr(k, 2, len(k) - 2))
ret = .t.
else
press("Comillas incorrectas, o falta operador '&'")
ret = .f.
endif
endif
ENDIF
endif
else
ret = .t.
endif
return ret
*
function addvar && agrega una variable
*--------------
local getlist := {}
private tipvar, pant, k, picvar, oldtip, valvar
m->oldtip = "X"
m->pant = savescreen(0, 0, 24, 79)
m->tipvar = " "
m->z_6_nomvar = space(10)
@ 16, 0 say "Nombre........:" get m->z_6_nomvar picture "@!" valid vnomvar(.f.)
@ 17, 0 say "Tipo..........:" get m->tipvar picture "@A!" valid vtipvar()
if doread(getlist)
if m->tipvar = "C"
if m->valvar == '""' + space(253)
keyboard chr(4)
readinsert(.t.)
endif
endif
@ 19, 0 say "Valor.........:" get m->valvar picture m->picvar valid vvalvar()
if doread(getlist)
m->z_6_nomvar = trim(m->z_6_nomvar)
m->z_6_cvar = m->z_6_cvar + 1
m->z_6_valvar = iif(type("m->valvar") = "C", trim(m->valvar), m->valvar)
m->z_6_var[m->z_6_cvar] = LEFT( m->z_6_nomvar + SPACE(10), 10) + " " + M->TIPVAR
endif
readinsert(.f.)
else
m->z_6_nomvar = ''
endif
restscreen(0, 0, 24, 79, m->pant)
return .f.
*------------------------------------------------------------
* Rutina.......: VNOMVAR
* Objetivo.....: Valida nombre de la variable
* Parámetros...: EXISTA (Lógica) Si .T. valido que exista. Si .F. valido que no exista
*------------------------------------------------------------
function vnomvar
*---------------
parameters exista
local ret
ret = .t.
if empty(m->z_6_nomvar)
ret = .f.
press("No puede ser vacío")
else
if !validname(m->z_6_nomvar)
ret = .f.
press("Nombre de variable inválido")
else
if mod_ascan(m->z_6_var, m->z_6_nomvar, 1, m->z_6_cvar) > 0
if !m->exista
ret = .f.
press("Variable existente")
endif
else
if m->exista
ret = .f.
press("Variable inexistente")
endif
endif
endif
endif
return ret
*
function validname
*-----------------
local k,ret
parameters valvar
m->valvar = alltrim(m->valvar)
k = left(m->valvar,1)
ret = .t.
if !k $ "ABCDEFGHIJKLMNOPQRSTUVWXYZ_"
ret = .f.
else
for k = 2 to len(m->valvar)
if !substr(m->valvar,k,1) $ "ABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789"
ret = .f.
EXIT
endif
next
endif
return ret
*
function copvar && copia una variable sobre otra ya existente
*--------------
local getlist := {}
local pant := savescreen(0, 0, 24, 79)
local ret
local k
private valvar
m->valvar = LEFT(m->z_6_var[m->z_6_choice],10)
m->z_6_nomvar = space(10)
@ 16, 0 say "Variable origen.: " + m->valvar
@ 17, 0 say "Tipo............: " + type(m->valvar)
@ 18, 0 say "Contenido.......:"
if iif(type(m->valvar) = "C", len(&(m->valvar)) > 30, .f.)
@ 18, 18 say left(&(m->valvar), 30)
setcolor("W+")
@ 18, 49 say ">> sigue >>"
setcolor("W")
else
@ 18, 18 say &(m->valvar)
endif
@ 19, 0 say "Variable destino:" get m->z_6_nomvar picture "@!" valid vcopvar()
ret = doread(getlist)
if ret
k = mod_ascan(m->z_6_var, m->z_6_nomvar, 1, m->z_6_cvar)
m->z_6_valvar = &(m->valvar)
m->z_6_nomvar = LEFT(m->z_6_var[k],10)
endif
restscreen(0, 0, 24, 79, pant)
return ret
*
function vcopvar && valida el nombre de la variable destino de una copia
*---------------
local ret,k
ret = .t.
if empty(m->z_6_nomvar)
ret = .f.
press("No puede ser vacío")
else
if !validname(m->z_6_nomvar)
ret = .f.
press("Nombre de variable inválido")
else
k = mod_ascan(m->z_6_var, m->z_6_nomvar, 1, m->z_6_cvar)
if k = 0
m->z_6_cvar ++
m->z_6_var[m->z_6_cvar] = LEFT(m->z_6_nomvar + SPACE(10), 10) +" "+ type(m->valvar)
else
m->z_6_var[m->k] = LEFT( m->z_6_nomvar + SPACE(10), 10) +" "+ type(m->valvar)
endif
endif
endif
return ret
*
function lecmem && Lee el archivo y carga sus variables al vector
*--------------
local buffer, tipo, prox, k
buffer = memoread(m->z_6_mem)
m->z_6_cvar = 0
while !empty(buffer)
m->z_6_cvar ++
k = at(chr(0), buffer)
tipo = substr(buffer, 12, 1)
do case
case tipo $ "N╬" && 206
* Numérico
prox = 41
TIPO = "N"
case tipo $ "L╠" && 204
* Lógico
prox = 34
TIPO = "L"
case tipo $ "D─" && 196
* Fecha
prox = 41
TIPO = "D"
case tipo $ "C├" && 195
* Carácter
prox = 33 + asc(substr(buffer, 17)) + asc(substr(buffer, 18)) * 256
TIPO = "C"
otherwise
press("Archivo .mem corrupto")
break
endcase
m->z_6_var[m->z_6_cvar] = LEFT( left(buffer, k - 1) + SPACE(10), 10) +" "+ TIPO
buffer = substr(buffer, prox)
if len(buffer) = 1
buffer = ''
endif
enddo
if m->z_6_cvar = 0
press("No hay variables a listar")
endif
return .f.
*
function fmenu && Función para achoice de menu
*-------------
parameters modo
local tecla, ret
ret = 2
tecla = lastkey()
do case
case m->modo = 0
* Idle
case m->modo = 1
* Cursor past top of list
keyboard chr(30) && Ctrl Pg-Dn
case m->modo = 2
* Cursor past end of list
keyboard chr(31) && Ctrl Pg-Up
case m->modo = 3
* Keystroke exception
do case
case tecla = 1
* Home
keyboard chr(31) && Ctrl Pg-Up
case tecla = 6
* End
keyboard chr(30) && Ctrl Pg-Dn
case tecla = 7
* Delete
m->z_6_accion = "D"
m->z_6_fila = row()
ret = 1
case tecla = 13
* Enter
m->z_6_accion = "M"
m->z_6_fila = row()
ret = 1
case tecla = 22
* Insert
addvar()
if !empty(m->z_6_nomvar)
m->z_6_accion = "A"
ret = 0
endif
case tecla = 27
* Escape
if confirma("la pérdida de los cambios realizados")
m->z_6_accion = "S"
ret = 0
endif
case chr(tecla) $ "Cc"
* Copiar
m->z_6_accion = "C"
m->z_6_fila = row()
ret = 1
case chr(tecla) $ "Ii"
* Imprimir
prmem()
case chr(tecla) $ "Gg"
* Grabar
if confirma("la grabación de los cambios")
m->z_6_accion = "G"
ret = 0
endif
otherwise
* tone(600, 1)
endcase
case m->modo = 4
* No item selectable
* No puede pasar en este caso
endcase
return ret
*
function doread(getlist) && realiza la lectura con cursor visible
*--------------
set cursor on
read
set cursor off
return lastkey() # 27
*------------------------------------------------------------
* Rutina.......: PRESS
* Objetivo.....: Pone un mensaje en la última línea y espera una tecla
* Parámetros...: TEXTO (Carácter) Mensaje a mostrar
*------------------------------------------------------------
function press
*-------------
parameters texto
local oldcolor
oldcolor = setcolor("W+")
centrar(24,80, m->texto + ". Pulse una tecla.")
tone(600,1)
inkey(10)
setcolor(oldcolor)
@ 24,0
return .f.
*------------------------------------------------------------
* Rutina.......: CONFIRMA
* Objetivo.....: Pide la confirmación de una acción
* Parámetros...: TEXTO (Carácter) Mensaje a mostrar
*------------------------------------------------------------
function confirma
*----------------
parameters texto
local tecla, oldcolor
oldcolor = setcolor("W+")
centrar(24,80, "¿Confirma " + m->texto + "? (S/N)")
tecla = "x"
while !tecla $ "SN"+chr(27)
tone(600,1)
tecla = upper(chr(inkey(0)))
enddo
setcolor(oldcolor)
@ 24, 0
return tecla = "S"
*------------------------------------------------------------
* Rutina.......: CENTRAR
* Objetivo.....: Centrar un texto
* Parámetros...: FILA (Numérico) Fila donde se centra el texto
* ANCHO (Numérico) Ancho de la fila donde se centra
* TEXTO (Carácter) Texto a centrar
* MARGEN (Numérico) Margen izquierdo (opcional)
*------------------------------------------------------------
function centrar
*---------------
parameters fila, ancho, texto, margen
if type("m->margen") # "N"
m->margen = 0
endif
@ m->fila, m->margen + (m->ancho - len(m->texto)) / 2 say m->texto
return .f.
*
function prmem && Imprime el .MEM
*-------------
local i,oo,tipo
if confirma("el comienzo de la impresión" + iif(m->z_6_print = "file", " a disco", ''))
if iif(m->z_6_print = "printer", isprinter(), .t.)
set device to print
set print on
set console off
tipo = "Listado de variables en " + m->z_6_mem
centrar(prow() + 1, 80, tipo)
centrar(prow() + 1, 80, replicate("=", len(tipo)))
@ prow() + 2, 0 say replicate("-", 80)
@ prow() + 1, 0 say "Variable Tipo Contenido"
@ prow() + 1, 0 say replicate("-", 80)
* 1234567890 1 1234567890123456789012345678901234567890123456789012345678901234
* 01234567890123456789012345678901234567890123456789012345678901234567890123456789
for i = 1 to m->z_6_cvar
oo = LEFT(m->z_6_var[i],10)
tipo = type(oo)
@ prow() + 1, 0 say oo
@ prow(), 12 say tipo
if tipo = "C"
oo = '"' + &oo + '"'
@ prow(), 16 say left(oo, 64)
elseif m->tipo = "N"
@ prow(), 16 say &oo picture "99999999999.999999"
else
@ prow(), 16 say &oo
endif
next
set device to screen
set print off
set console on
press("Impresión terminada")
endif
endif
return .f.
*
function mod_ascan(vector,valor,desde,hasta)
*-----------------
local k,l,pos
l = left(valor,10)
pos = 0
for k = desde to hasta
if l == left(vector[k],10)
pos = k
EXIT
endif
next
return pos