FUNCTION creanom(xnombre)
LOCAL tabla_asc,tabla_ecr,nomreg,i,j,letra
tabla_asc := {" ","1","2","3","4","5","6","7","8","9",;
"A","B","C","D","E","F","G","H","I","J",;
"K","L","M","N","P","Q","R","S","T","U",;
"V","W","X","Y","Z","0","@","%","&","+",;
"-"," ","*","!","#",":"," ","$"," ","'",;
"/",",",",","^","O"}
tabla_ecr := {"20","31","32","33","34","35","36","37","38","39",;
"41","42","43","44","45","46","47","48","49","4A",;
"4B","4C","4D","4E","50","51","52","53","54","55",;
"56","57","58","59","5A","30","40","25","26","2B",;
"2D","20","2A","21","23","3A","20","24","20","27",;
"2F","2C","2C","5E","4F"}
nomreg = ""
FOR i = 1 TO LEN(xnombre)
letra = SUBSTR(xnombre,i,1)
j = ASCAN(tabla_asc,letra)
IF j = 0
j = 1
ENDIF
nomreg = nomreg + tabla_ecr[j]
NEXT
RETURN LEFT(nomreg,36)
FUNCTION crearbcc(p1)
LOCAL bcc,i
bcc = CHR(0)
FOR i = 1 TO LEN(p1)
bcc := charxor(bcc,SUBSTR(p1,i,1))
NEXT
RETURN bcc
FUNCTION abrirport(n)
LOCAL IdPort,cDcb,nError
IdPort := OpenComm("COM"+STR(n,1),1024,256)
IF IdPort <= 0
nError = GetCommError( IdPort)
MsgInfo( "Error al abrir: " + Str( nError ) )
ELSE
MsgRun("Puerto abierto como " + STR(IdPort))
ENDIF
IF ! BuildCommDcb("COM"+STR(n,1)+":9600,n,8,1" , @cDcb)
nError = GetCommError( IdPort)
MsgInfo( "Error al Configurar: " + Str( nError ) )
RETURN 0
ELSE
MsgRun("Puerto Configurado")
ENDIF
IF ! SetCommState( IdPort, cDcb )
nError = GetCommError( IdPort)
MsgInfo( "Error al setear: " + Str( nError ) )
RETURN 0
ELSE
MsgRun("Puerto Seteado")
ENDIF
RETURN IdPort
PROCEDURE mandar(port,string)
LOCAL nBytes
IF (nBytes := WriteComm( port,string) ) < 0
MsgAlert("Mando mal string")
ENDIF
RETURN
FUNCTION leer_ack(port)
LOCAL fallo, ack := " ", nBytes,i := 1
fallo = .t.
DO WHILE .t.
MsgWait("Leyendo Ack ","Espere",.15)
nBytes := ReadComm( port,@ack)
i++
IF i > 20 .or. ack <> " "
EXIT
ENDIF
ENDDO
IF ack <> ""
fallo = .f.
MsgInfo(asc(ack),memvar->musuanom)
ENDIF
RETURN fallo
FUNCTION leer_enq(port)
LOCAL fallo,enq:=" ",nBytes,i := 1
fallo = .t.
DO WHILE .t.
MsgWait("Leyendo Enq","Espere",.3)
nBytes := ReadComm( port,@enq)
i++
IF i > 20 .or. enq <> " "
EXIT
ENDIF
ENDDO
IF enq <> ""
fallo = .f.
MsgInfo(asc(enq),memvar->musuanom)
ENDIF
RETURN fallo
FUNCTION leer_eot(port)
LOCAL fallo,eot := " " ,nBytes,i := 1
fallo = .t.
DO WHILE .t.
MsgWait("Leyendo EoT","Espere",.3)
nBytes := ReadComm( port,@eot)
i++
IF eot = CHR(6)
MsgWait("Esperando por EoT","Espere",5)
LOOP
ENDIF
IF i > 20 .or. eot <> " "
EXIT
ENDIF
ENDDO
IF eot <> ""
fallo = .f.
MsgInfo(asc(eot),memvar->musuanom)
ENDIF
RETURN fallo
PROCEDURE mandar_eot(port)
LOCAL nBytes
*IF ( nBytes := WriteComm( port, "" )) <= 0
IF ( nBytes := WriteComm( port, CHR(4) )) <= 0
MsgAlert("Mando mal EOT")
ENDIF
RETURN
FUNCTION mandar_enq(port)
LOCAL mcont,retorno,nBytes
retorno = .t.
FOR mcont := 1 TO 10
* IF ( nBytes := WriteComm( port, "" )) <= 0
IF ( nBytes := WriteComm( port, CHR(5))) <= 0
MsgAlert("Mando mal ENQ")
retorno := .f.
ELSE
retorno := .t.
EXIT
ENDIF
MsgWait("Enviando datos...","Aguarde",1)
NEXT
RETURN retorno
PROCEDURE mandar_ack(port)
LOCAL nBytes
*IF ( nBytes := WriteComm( port, "" )) <= 0
IF ( nBytes := WriteComm( port, CHR(6))) <= 0
MsgAlert("Mando mal ACK")
ENDIF
RETURN
FUNCTION leer_bloque(port,n)
LOCAL bloque:= SPACE(n),bcc1,nBytes,i:=1
DO WHILE .t.
*MsgWait(bloque,"Espere",.2)
nBytes := ReadComm( port,@bloque)
i++
IF EMPTY(bloque)
MsgWait("Esperando ENQ","Espere",3)
mandar_enq(port)
LOOP
ENDIF
*bloque := IF(EMPTY(bloque),"",bloque)
IF i > 20 .or. bloque <> SPACE(n)
EXIT
ENDIF
ENDDO
bcc1 = crearbcc(SUBSTR(bloque,2,LEN(bloque)-2))
IF RIGHT(bloque,1) <> bcc1 .and. !(""$bloque)
*MsgAlert(OemtoAnsi(bloque),STR(ASC(bcc1))+" <> "+STR(ASC(RIGHT(bloque,1))))
MEMVAR->falla = .t.
ENDIF
RETURN bloque
FUNCTION bloqueaECR(mport,ecr)
LOCAL stx,mark,id,tarea,fecha,etx,bcc,tipo,desde,hasta,omitir,salida,ack,;
responde
salida = .t.
stx = ""
mark = "S"
id = "01"
tarea = "<"
tipo = "0"
desde = "0000000000000"
hasta = "0000000000000"
omitir = "0"
fecha = STRTRAN(STR(DAY(DATE()),2)+STR(MONTH(DATE()),2)+SUBSTR(STR(YEAR(DATE()),4),2,2)," ","0")
etx = ""
bcc := crearbcc(mark+id+ecr+tarea+tipo+desde+hasta+omitir+fecha+etx)
mport := abrirport(mport)
MsgWait("Aguarde","Espere",.25)
mandar_enq(mport)
IF !leer_ack(mport)
responde = MsgYesNo("Recibio mal ACK 1")
IF !responde
CloseComm(mport)
RETURN .F.
ENDIF
ENDIF
MsgWait("Aguarde","Espere",.25)
mandar(mport,stx+mark+id+ecr+tarea+tipo+desde+hasta+omitir+fecha+etx+bcc)
IF !leer_ack(mport)
MsgAlert("La ECR se encuentra ocupada o con error")
salida = .f.
ENDIF
mandar_eot(mport)
CloseComm(mport)
RETURN salida
FUNCTION desbloqECR(mport,ecr)
LOCAL stx,mark,id,tarea,fecha,etx,bcc,tipo,desde,hasta,omitir,salida,responde
salida = .t.
stx = ""
mark = "S"
id = "01"
tarea = ">"
tipo = "0"
desde = "0000000000000"
hasta = "0000000000000"
omitir = "0"
fecha = STRTRAN(STR(DAY(DATE()),2)+STR(MONTH(DATE()),2)+SUBSTR(STR(YEAR(DATE()),4),2,2)," ","0")
etx = ""
bcc := crearbcc(mark+id+ecr+tarea+tipo+desde+hasta+omitir+fecha+etx)
mport := abrirport(mport)
MsgWait("Aguarde","Espere",.35)
mandar_enq(mport)
IF !leer_ack(mport)
responde = MsgYesNo("Recibio mal ACK 1")
IF !responde
CloseComm(mport)
RETURN .F.
ENDIF
ENDIF
MsgWait("Aguarde","Espere",.35)
mandar(mport,stx+mark+id+ecr+tarea+tipo+desde+hasta+omitir+fecha+etx+bcc)
IF !leer_ack(mport)
MsgAlert("La ECR se encuentra ocupada o con error")
salida = .f.
ENDIF
mandar_eot(mport)
closeComm(mport)
RETURN salida
FUNCTION CharXOR(car1,car2)
LOCAL n1:=ARRAY(8),n2:=ARRAY(8),res,i,r:=""
n1 := DtoB(ASC(car1))
n2 := DtoB(ASC(car2))
FOR i = 1 to 8
IF SUBSTR(n1,i,1) <> SUBSTR(n2,i,1)
r := r + "1"
ELSE
r := r + "0"
ENDIF
NEXT
res = BtoD(r)
RETURN CHR(res)
FUNCTION DtoB(n)
LOCAL arr:="",i
FOR i = 1 to 8
arr := arr + STR(n % 2,1)
n = INT(n/2)
NEXT
RETURN arr
FUNCTION BtoD(num)
LOCAL res,a:=ARRAY(8),i
FOR i = 1 to 8
a[9-i] := VAL(SUBSTR(num,i,1))
NEXT i
res := a[1]*128+a[2]*64+a[3]*32+a[4]*16+a[5]*8+a[6]*4+a[7]*2+a[8]*1
RETURN res