Deu certo muinto grato aos amigos que ajudaram.
Agora tenho outro caso semelhante porem desta vez tenho a criptografia e precizo fazer uma alteração no cadastro da empresa e ja tentei de varias formas e nao deu certo.
fonte original das funcoes em anexo juntamente com a tabela dbf onde fica o cadastro da empresa e arquivo tipo .mem
Código: Selecionar todos
#include "common.ch"
#include "inkey.ch"
FUNCTION MAIN
set exact on
clear screen
readkill(.T.)
getlist:= {}
set exclusive off
public dado
kmold:= .T.
private mcab[4], dado[50]
afill(dado, Replicate("%%*%*$^*&^", 7) + "%%*%")
mcab[1]:= "MEMPRE"
mcab[2]:= "CODEMP"
mcab[3]:= "MERASO"
mcab[4]:= "MECGCE"
arqi := "SPAG0.MEM"+Space(22)
empr := "empresas.dbf"+Space(20)
demo := "N"
dtvl := DATE() //CToD(" / / ")
qtde:= 50
indmat:= 1
hum:= .T.
@ 0, 1 say "ARQ.INPUT.:" get ARQI
@ 1, 1 say "EMPRESAS..:" get EMPR
@ 2, 1 say "VALIDADE..:" get DTVL picture "@E"
@ 3, 1 say "DEMONS.?..:" get DEMO
read
readkill(.T.)
getlist:= {}
if (demo = "S")
@ 4, 1 say "QTDE.FUNC.:" get QTDE picture "999"
read
readkill(.T.)
getlist:= {}
endif
dtvl:= DToC(dtvl)
autm:= "S"
@ 5, 1 say "SEL.AUTOM?:" get AUTM picture "X" valid autm $ "SN"
read
readkill(.T.)
getlist:= {}
use (empr)
if (autm = "N")
@ 5, 1 say Space(20)
index on MERASO to EMPR_NOM
dbedit(5, 0, 18, 79, mcab, "EFEOVL", .T., .T., .T., .T., "ÍÏÍ")
else
index on MEMPRE+CODEMP to EMPR_COD
do while (.T.)
do while (.T.)
wempre:= "AQUM"
@ 5, 20 say "DIGITE CODIGO..:" get WEMPRE picture "XXXX"
@ 21, 0, 23, 33 box "Õ͸³¾ÍÔ³ "
@ 22, 2 say "*** TECLE [ENTER] P/ RETORNAR"
read
readkill(.T.)
getlist:= {}
if (wempre == " ")
fazovl()
endif
set exact off
seek wempre
set exact on
if (EOF())
ask("*** CODIGO INEXISTENTE ! TECLE [ENTER]", " ")
loop
endif
exit
enddo
@ 21, 0 clear to 23, 33
wlin:= 0
do while (mempre = wempre .AND. indmat <= 50 .AND. !EOF())
mmatriz(2)
skip
enddo
conf:= "S"
@ wlin + 1, 1 say "CONFIRME..:" get CONF picture "X" valid ;
conf $ "SN"
read
readkill(.T.)
getlist:= {}
if (conf = "N")
afill(dado, Replicate("%%*%*$^*&^", 7) + "%%*%")
indmat:= 1
@ 7, 0 clear to 19, 79
loop
endif
exit
enddo
fazovl()
endif
close databases
if (file("EMPR_NOM.NTX"))
erase EMPR_NOM.NTX
endif
if (file("EMPR_COD.NTX"))
erase EMPR_COD.NTX
endif
return
********************************
function EFEOVL
parameters edmod, edind
if (edmod < 4)
elseif (LastKey() = K_ESC)
fazovl()
return 0
elseif (LastKey() = K_ENTER)
mmatriz(1)
endif
return iif(hum, 1, 0)
********************************
function MMATRIZ
parameters tipo
if (tipo == 1)
conf:= "S"
@ 20, 1 say "R.SOCIAL..:" + meraso
@ 21, 1 say "CABECALHO.:" + mecabe
@ 22, 1 say "CGC.......:" + mecgce
@ 23, 1 say "CONFIRME..:" get CONF
read
readkill(.T.)
getlist:= {}
if (conf = "N")
return .F.
endif
dado[indmat]:= Left(meraso, 40) + Left(mecabe, 15) + ;
Left(mecgce, 18) + Left(codemp, 2) + "*"
indmat:= indmat + 1
if (indmat == 51)
fazovl()
hum:= .F.
endif
return .T.
else
if (indmat == 1)
@ 7, 1 say "RAZAO SOCIAL" + Space(29) + ;
"CABECALHO C.G.C."
@ 8, 1 to 8, 75 double
wlin:= 9
endif
if (wlin == 20)
ask("*** TECLE [ENTER] P/ CONTINUAR", " ")
wlin:= 9
@ 9, 0 clear to 19, 79
endif
@ wlin, 1 say meraso + " " + mecabe + " " + mecgce
wlin:= wlin + 1
dado[indmat]:= Left(meraso, 40) + Left(mecabe, 15) + ;
Left(mecgce, 18) + Left(codemp, 2) + "*"
indmat:= indmat + 1
endif
********************************
function ASK
parameters nwa, nwb
private nwc, nwd
if (kmold)
nwd:= SaveScreen(21, 0, 23, Len(nwa) + 4)
@ 21, 0, 23, Len(nwa) + 4 box "Õ͸³¾ÍÔ³ "
else
@ 22, 1 clear to 23, 68
if (Len(nwb) > 1)
@ 23, 2 say "*** DIGITE A SUA OPCAO"
endif
endif
@ 22, 2 say nwa
do while (.T.)
nwc:= InKey(0)
if (nwc < 0)
nwc:= nwc + 256
endif
nwc:= iif(nwc = 13, " ", Chr(nwc))
if (nwc $ nwb)
exit
endif
enddo
if (kmold)
RestScreen(21, 0, 23, Len(nwa) + 4, nwd)
else
@ 22, 1 clear to 23, 68
endif
return Upper(nwc)
********************************
/*procedure SYSINIT
return
*/
********************************
function FAZOVL
indmat:= indmat - 1
if (indmat == 0)
clear screen
readkill(.T.)
getlist:= {}
? "NAO HA EMPRESA SELECIONADA"
quit
endif
private mdef[indmat]
for i:= 1 to indmat
mdef[i]:= Left(dado[i], 40)
next
@ 5, 0 clear to 18, 79
@ 6, 8 to 18, 56 double
@ 6, 12 say "ESCOLHA A EMPRESA DEFAULT"
do while (.T.)
defa:= achoice(7, 10, 17, 54, mdef)
if (defa != 0)
exit
endif
enddo
clear screen
readkill(.T.)
getlist:= {}
@ Row(), 0 say "*** AGUARDE..."
defa:= SubStr(Str(defa / 100, 4, 2), 3, 2)
// dadop:= demo + Str(qtde, 2) + dtvl + defa + Str(indmat, 2)
dadop:= [2] + Str(qtde, 3) + dtvl + defa + Str(indmat, 2)
arqo:= "SPAG41.MEM"
arqi:= Trim(LTrim(arqi))
arqo:= Trim(LTrim(arqo))
for kcod:= 1 to 50
@ Row(), 25 say kcod
for j:= 1 to 3
par1:= Left(dado[kcod], 38)
par2:= right(dado[kcod], 38)
dado[kcod]:= ""
for i:= 1 to 38
dado[kcod]:= dado[kcod] + SubStr(par1, i, 1)
dado[kcod]:= dado[kcod] + SubStr(par2, i, 1)
next
next
fi:= ""
for i:= 1 to 76
fi:= fi + Chr(Asc(SubStr(dado[kcod], i, 1)) - 32)
next
to:= 0
for i:= 1 to 75 step 5
c1:= Asc(SubStr(fi, i + 2, 1))
c2:= Asc(SubStr(fi, i + 1, 1))
c3:= Asc(SubStr(fi, i + 0, 1))
c4:= Asc(SubStr(fi, i + 3, 1))
c5:= Asc(SubStr(fi, i + 4, 1))
to:= to + (c1 * c2 - c3 * c4 + c5)
next
// altd()
dado[kcod]:= fi + right(Str(to, 10), 2)
next
? "*** GERANDO ARQUIVO..."
if (!file(arqi))
? "Arquivo " + arqi + " nao existe..."
quit
endif
if (file(arqo))
FERASE( arqo )
quit
endif
hi:= fopen(arqi)
ho:= fcreate(arqo)
if (ferror() == 0)
total:= fseek(hi, 0, 2)
fseek(hi, 0)
? "Pesquisando localizacao da chave..."
do while (total > 0)
buffer:= Space(512)
nblido:= fread(hi, @buffer, 512)
posica:= At("NETWORKPARAMETRO", buffer)
if (posica > 0)
exit
endif
if (fwrite(ho, buffer, nblido) < nblido)
? " ERRO DE GRAVACAO", ferror()
endif
total:= total - nblido
enddo
? "Gravando chave"
fseek(hi, -512, 1)
nwbuf:= Space(4096)
nblidos:= fread(hi, @nwbuf, 4096)
private pos[51], ji[50], pof[51]
pos[1]:= At("NETWORKPARAMETRO", nwbuf)
pos[2]:= At("01NETWORKKEY", nwbuf)
pos[3]:= At("02NETWORKKEY", nwbuf)
pos[4]:= At("03NETWORKKEY", nwbuf)
pos[5]:= At("04NETWORKKEY", nwbuf)
pos[6]:= At("05NETWORKKEY", nwbuf)
pos[7]:= At("06NETWORKKEY", nwbuf)
pos[8]:= At("07NETWORKKEY", nwbuf)
pos[9]:= At("08NETWORKKEY", nwbuf)
pos[10]:= At("09NETWORKKEY", nwbuf)
pos[11]:= At("10NETWORKKEY", nwbuf)
pos[12]:= At("11NETWORKKEY", nwbuf)
pos[13]:= At("12NETWORKKEY", nwbuf)
pos[14]:= At("13NETWORKKEY", nwbuf)
pos[15]:= At("14NETWORKKEY", nwbuf)
pos[16]:= At("15NETWORKKEY", nwbuf)
pos[17]:= At("16NETWORKKEY", nwbuf)
pos[18]:= At("17NETWORKKEY", nwbuf)
pos[19]:= At("18NETWORKKEY", nwbuf)
pos[20]:= At("19NETWORKKEY", nwbuf)
pos[21]:= At("20NETWORKKEY", nwbuf)
pos[22]:= At("21NETWORKKEY", nwbuf)
pos[23]:= At("22NETWORKKEY", nwbuf)
pos[24]:= At("23NETWORKKEY", nwbuf)
pos[25]:= At("24NETWORKKEY", nwbuf)
pos[26]:= At("25NETWORKKEY", nwbuf)
pos[27]:= At("26NETWORKKEY", nwbuf)
pos[28]:= At("27NETWORKKEY", nwbuf)
pos[29]:= At("28NETWORKKEY", nwbuf)
pos[30]:= At("29NETWORKKEY", nwbuf)
pos[31]:= At("30NETWORKKEY", nwbuf)
pos[32]:= At("31NETWORKKEY", nwbuf)
pos[33]:= At("32NETWORKKEY", nwbuf)
pos[34]:= At("33NETWORKKEY", nwbuf)
pos[35]:= At("34NETWORKKEY", nwbuf)
pos[36]:= At("35NETWORKKEY", nwbuf)
pos[37]:= At("36NETWORKKEY", nwbuf)
pos[38]:= At("37NETWORKKEY", nwbuf)
pos[39]:= At("38NETWORKKEY", nwbuf)
pos[40]:= At("39NETWORKKEY", nwbuf)
pos[41]:= At("40NETWORKKEY", nwbuf)
pos[42]:= At("41NETWORKKEY", nwbuf)
pos[43]:= At("42NETWORKKEY", nwbuf)
pos[44]:= At("43NETWORKKEY", nwbuf)
pos[45]:= At("44NETWORKKEY", nwbuf)
pos[46]:= At("45NETWORKKEY", nwbuf)
pos[47]:= At("46NETWORKKEY", nwbuf)
pos[48]:= At("47NETWORKKEY", nwbuf)
pos[49]:= At("48NETWORKKEY", nwbuf)
pos[50]:= At("49NETWORKKEY", nwbuf)
pos[51]:= At("50NETWORKKEY", nwbuf)
pof[1]:= pos[1] + 16
for ii:= 2 to 51
pof[ii]:= pos[ii] + 78
next
afill(ji, 1)
xb:= ""
jj:= 1
for ii:= 1 to nblidos
do case
case ii >= pos[1] .AND. ii < pof[1]
k:= 0
case ii >= pos[2] .AND. ii < pof[2]
k:= 1
case ii >= pos[3] .AND. ii < pof[3]
k:= 2
case ii >= pos[4] .AND. ii < pof[4]
k:= 3
case ii >= pos[5] .AND. ii < pof[5]
k:= 4
case ii >= pos[6] .AND. ii < pof[6]
k:= 5
case ii >= pos[7] .AND. ii < pof[7]
k:= 6
case ii >= pos[8] .AND. ii < pof[8]
k:= 7
case ii >= pos[9] .AND. ii < pof[9]
k:= 8
case ii >= pos[10] .AND. ii < pof[10]
k:= 9
case ii >= pos[11] .AND. ii < pof[11]
k:= 10
case ii >= pos[12] .AND. ii < pof[12]
k:= 11
case ii >= pos[13] .AND. ii < pof[13]
k:= 12
case ii >= pos[14] .AND. ii < pof[14]
k:= 13
case ii >= pos[15] .AND. ii < pof[15]
k:= 14
case ii >= pos[16] .AND. ii < pof[16]
k:= 15
case ii >= pos[17] .AND. ii < pof[17]
k:= 16
case ii >= pos[18] .AND. ii < pof[18]
k:= 17
case ii >= pos[19] .AND. ii < pof[19]
k:= 18
case ii >= pos[20] .AND. ii < pof[20]
k:= 19
case ii >= pos[21] .AND. ii < pof[21]
k:= 20
case ii >= pos[22] .AND. ii < pof[22]
k:= 21
case ii >= pos[23] .AND. ii < pof[23]
k:= 22
case ii >= pos[24] .AND. ii < pof[24]
k:= 23
case ii >= pos[25] .AND. ii < pof[25]
k:= 24
case ii >= pos[26] .AND. ii < pof[26]
k:= 25
case ii >= pos[27] .AND. ii < pof[27]
k:= 26
case ii >= pos[28] .AND. ii < pof[28]
k:= 27
case ii >= pos[29] .AND. ii < pof[29]
k:= 28
case ii >= pos[30] .AND. ii < pof[30]
k:= 29
case ii >= pos[31] .AND. ii < pof[31]
k:= 30
case ii >= pos[32] .AND. ii < pof[32]
k:= 31
case ii >= pos[33] .AND. ii < pof[33]
k:= 32
case ii >= pos[34] .AND. ii < pof[34]
k:= 33
case ii >= pos[35] .AND. ii < pof[35]
k:= 34
case ii >= pos[36] .AND. ii < pof[36]
k:= 35
case ii >= pos[37] .AND. ii < pof[37]
k:= 36
case ii >= pos[38] .AND. ii < pof[38]
k:= 37
case ii >= pos[39] .AND. ii < pof[39]
k:= 38
case ii >= pos[40] .AND. ii < pof[40]
k:= 39
case ii >= pos[41] .AND. ii < pof[41]
k:= 40
case ii >= pos[42] .AND. ii < pof[42]
k:= 41
case ii >= pos[43] .AND. ii < pof[43]
k:= 42
case ii >= pos[44] .AND. ii < pof[44]
k:= 43
case ii >= pos[45] .AND. ii < pof[45]
k:= 44
case ii >= pos[46] .AND. ii < pof[46]
k:= 45
case ii >= pos[47] .AND. ii < pof[47]
k:= 46
case ii >= pos[48] .AND. ii < pof[48]
k:= 47
case ii >= pos[49] .AND. ii < pof[49]
k:= 48
case ii >= pos[50] .AND. ii < pof[50]
k:= 49
case ii >= pos[51] .AND. ii < pof[51]
k:= 50
otherwise
k:= 99
endcase
if (k = 99)
xb:= xb + SubStr(nwbuf, ii, 1)
elseif (k = 0)
xb:= xb + SubStr(dadop, jj, 1)
jj:= jj + 1
else
xb:= xb + SubStr(dado[k], ji[k], 1)
ji[k]:= ji[k] + 1
endif
next
nwbuf:= xb
if (fwrite(ho, nwbuf, nblidos) < nblidos)
? " ERRO DE GRAVACAO", ferror()
endif
total:= total - nblidos
? "Gravando o restante do arquivo "
do while (total > 0)
nwbuf:= Space(4096)
nblidos:= fread(hi, @nwbuf, 4096)
if (fwrite(ho, nwbuf, nblidos) < nblidos)
? " ERRO DE GRAVACAO", ferror()
endif
total:= total - nblidos
enddo
else
? " ERRO DE ABERTURA ", ferror()
endif
fclose(hi)
fclose(ho)
return .T.
