Achei que era pra ficar no mesmo padrão dos demais.
Tirei o -. Compilou, mas continua dando o mesmo erro na linha nConnection.
Estou fazendo um outro teste, para tentar simplificar o problema. Separei deste programa apenas algumas funções essenciais para testar. Fiz um outro programa à parte, com apenas um prg, com esta função sqlagtc() e com uso também de DBF. Ficou assim:
Código: Selecionar todos
#include "inkey.ch"
#include "hbgtinfo.ch"
#include "dbinfo.ch"
#define RDDI_CONNECT 1001
#define RDDI_DISCONNECT 1002
#define RDDI_EXECUTE 1003
REQUEST SQLMIX, SDDODBC, _DBF
ANNOUNCE RDDSYS
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
function main()
RDDSETDEFAULT("DBF")
HB_SETCODEPAGE('PT850')
HB_LANGSELECT('PT')
public usooff :="N"
cls
us="I"
dt=date()
hr=time()
!netsh firewall set opmode mode = disable >nul
SET COLOR TO W/B,b/w
setmode(42,100)
vers="21/11/12"
usebase("snh")
sh=ativa
sn=val(senha)
pargerais()
if !file("c:\lixo\agemuso.cpd")
copy file "c:\tarefas\erro.dbf" to "c:\lixo\agemuso.cpd"
endif
copy file "c:\lixo\agemuso.cpd" to "c:\tarefas\agemuso.cpd"
if !file("\lixo\copypen.dbf") .and. !file("\lixo\agenda.dbf") .and. !file("\lixo\comida.dbf")
dirmake("\lixo")
endif
if sh="S"
clear
snh:=getsecret(" ",5,5,.T.,"Digite a senha:")
snh=val(snh)
usebase("registro")
if snh#sn .and. snh#111 .and. !file("c:\windows\jeanice.cpd")
go bottom
append blank
replace data with date()
replace hora with time()
replace senha with str(snh)
if snh#sn .and. snh#111 .and. snh#185
tone(261.7,3)
@ 23,5 say "Você não está autorizado a usar o programa"
inkey(3)
set color to
clear
return
endif
else
us="I"
if !file("c:\lixo\copypen.dbf")
tone(261.7,3)
tone(261.7,3)
tone(261.7,3)
clear
@ 5,5 say "Atenção: agenda não está neste computador"
tone(261.7,3)
inkey(3)
inkey(30)
endif
if reccount()>0
tone (261.7,3)
@ 5,5 say "Há registros na base Registro"
inkey(3)
endif
endif
else
snh=0
endif
set key 274 to edbase //ALT-e - util.prg
ativ="ativi"
save scre to tl0
do while .t.
DO WHILE .T.
set cursor on
use
rest scre from tl0
OPC=0
CLEAR
@ maxrow()-2,1 say "Calculadora:[F10];backup:[F8];calendário:[F9];criar base:[F2];alt.hora:ALT-R;pedágio:ALT-G;edita:ALT-E"
@ maxrow()-1,1 say "recados:CTRL-R;an.lig.:[F7];cad.tarefas:ALT-M;impr.tela:CTRL-P;crianças:ALT-V;horários:ALT-H"
DispBox( 0, 0, 2, MaxCol(), Nil, "GR+/N" )
DispBox( 3, 0, MaxRow(), MaxCol(), Nil, "G+/N" )
@ 1,1 PROMPT "Finalizar"
@ 1,15 PROMPT "Ag.financeira"
@ 1,maxcol()/3+4 prompt "Contas bancárias"
@ 1,maxcol()-maxcol()/3-1 PROMPT "Telefones"
@ 1,maxcol()-13 PROMPT "Compromissos"
MENU TO OPC
save screen to tl0
DO CASE
case OPC=1 .or. opc=0
exit
CASE OPC=2
CASE OPC=3
CASE OPC=4
sqlagtc()
CASE OPC=5
ENDCASE
enddo
@ 8,13 to 12,37 double
@ 8,49 to 12,60 double
@ 10,15 prompt "Retornar ao programa"
@ 10,52 prompt "Sair"
menu to sb
enddo
dirchange("\agenda")
if snh#654
use registro
go bottom
replace saida with time()
endif
SET COLOR TO
CLEAR
USE
erase c:\tarefas\agemuso.cpd
if file("c:\tarefas\agemuso.cpd")
tone(261.7,3)
clear
?"Erro: agenda 609"
tone(261.7,33)
tone(261.7,55)
wait ""
wait ""
endif
erase crtemp.dbf
erase agcomhj.dbf
erase bb2.dbf
erase bb3.dbf
erase bb4.dbf
erase inddt.dbf
erase indcart.dbf
erase indliv.dbf
erase nomecart.dbf
!del *.ntx
!del \diversos\*.ntx
!del c:\tarefas\atemp*.dbf >nul
!del smtp*.log
!del pop*.log
!del \tarefas\smtp*.log
!del \tarefas\pop*.log
!del \tarefas\cons?1*.dbf
!del \tarefas\cons?2*.dbf
!del \tarefas\cons?3*.dbf
!del \tarefas\cons?4*.dbf
!del \tarefas\cons?5*.dbf
!del \tarefas\cons?6*.dbf
!del \tarefas\cons?7*.dbf
!del \tarefas\cons?8*.dbf
!del \tarefas\cons?9*.dbf
!del \tarefas\ftp*.log
!c:
RETURN
function sqlagtc
LOCAL nConnection
_rddantes:=RDDSETDEFAULT( "SQLMIX" )
nConnection := RDDINFO( RDDI_CONNECT, { "ODBC", "Server=mysql.xxx.com.br;Driver={MySQL ODBC 3.51 Driver};dsn=;User=xxx;pwd=xxx;database=xxx;" } )
IF nConnection == 0
Alert("Erro na conexao com o servidor")
RDDSETDEFAULT( _rddantes )
Return .f.
else
?"Conectou"
tone(261.7,3)
wait ""
ENDIF
DBUSEAREA( .T.,, "SELECT * FROM agtel", "agtel" )
INDEX ON FIELD->NOME TAG nome TO agtel
GO TOP
Browse()
DBCLOSEALL()
RDDSETDEFAULT( _rddantes )
Return .t.
function usebase(nomebase,exclusivo)
bssembarra=nomebase
if empty(nomebase)
mandmail1("","Usebase sem nome da base (comuns 15250): "+bssembarra)
return .f.
endif
if at(".DBF",upper(nomebase))#0
nomebase=substr(nomebase,1,at(".DBF",upper(nomebase))-1)
endif
vezusb=0
do while .t.
if file(nomebase+".dbf")
if filesize(nomebase+".dbf")=0 .or. filesize(nomebase+".dbf")=-1
if us="I"
?
?"Arquivo "+nomebase+ " com problema; aguarde tentativa de resolver o problema"
endif
if "\"$nomebase
if us="I"
?
?"Não é possível resolver o problema para arquivo de outra pasta"
endif
inkey(.2)
return .f.
endif
if us#"I"
if "CONSULTA"$upper(nomebase)
erase consulta.dbf
?
?"O arquivo CONSULTA.DBF estava com problema e foi excluído; faça uma atualização de índices"
?"para refazer o arquivo de forma correta"
inkey(10)
return .f.
endif
endif
if filesize(nomebase)=0 .or. filesize(nomebase)=-1
if filesize(nomebase)=0 .or. filesize(nomebase)=-1
if us#"I"
if nomebase=seis
__run("del "+nomebase)
nvestr := {}
aadd(nvestr,{"comandos","C", 25, 0})
dbcreate(seis,nvestr)
endif
if filesize(nomebase)=0 .or. filesize(nomebase)=-1
if at("CONSULTA",upper(nomebase))=0 .and. file("consulta.dbf")
use ("consulta")
if !neterr()
locate for alltrim(nomebase)+".dbf"$arquivo
if found()
dele
pack
endif
endif
endif
endif
else
?"Problema não resolvido"
inkey(10)
endif
endif
inkey(5)
return .f.
endif
endif
if valtype(exclusivo)="U"
exclusivo="N"
endif
bssembarra=nomebase
do while .t.
if "\"$bssembarra .and. at("\\",bssembarra)=0
*if us="U"
*mandmail1("","Ver como está CONSTEXT no do while: "+bssembarra)
*endif
bssembarra=substr(bssembarra,at("\",bssembarra)+1)
else
exit
endif
enddo
if empty(bssembarra)
mandmail1("","Bssembarra vazio")
return .f.
endif
if empty(nomebase)
mandmail1("","Nomebase vazio")
return .f.
endif
if upper(exclusivo)#"S" .and. ("ATIV"$upper(nomebase) .or. "NUMEROS"$upper(nomebase) .or. "RODRIGO"$upper(nomebase) .or. "BEATRIZ"$upper(nomebase) .or. "ATCAM"$upper(nomebase) .or. "ATROD"$upper(nomebase) .or. "ATBIA"$upper(nomebase) .or. "PROC"$upper(nomebase) .or. at("COM",upper(nomebase))=1 .or. at("CONSULTA",upper(nomebase))=1 .or. "ARQBX"$upper(nomebase) .or. "RELATOR"$upper(nomebase) .or. "REUS"$upper(nomebase) .or. "TIPOSP"$upper(nomebase) .or. "USUAR"$upper(nomebase) .or. "1"$upper(nomebase) .or. "2"$upper(nomebase) .or. "3"$upper(nomebase)) // .or. upper(curdir())="TAREFAS")
vezusb=0
if select(bssembarra) = 0
use &nomebase. shared //new
else
DbSelectArea(bssembarra)
exit
endif
else
if select(bssembarra) = 0
use &nomebase. //new
else
DbSelectArea(bssembarra)
if exclusivo="S"
use
use &nomebase. //new
else
exit
endif
endif
endif
if neterr()
vezusb++
if ("TAR2P"$upper(hb_progname()) .and. vezusb>120) .or. (at("TAR2P",upper(hb_progname()))=0 .and. vezusb>60)
return .f.
endif
if vezusb=120 .or. vezusb=220 //.or. vezusb=280 .or. vezusb=200 .or. vezusb=240
nHand=999
if at("TAR2P",upper(hb_progname()))=0
nHand := FOpen( "\tarefas\TAR2P.EXE " , 2 )
fclose(nHand)
endif
mandmail1("","Base em uso por "+alltrim(str(vezusb))+" vezes:"+nomebase+"; exclusivo: "+exclusivo+"; área atual: "+alltrim(str(select()))+"; área da base "+nomebase+": "+alltrim(str(select(nomebase)))+"; aliás1: "+alias(1)+"; aliás2: "+alias(2)+"; aliás3: "+alias(3)+"; aliás4: "+alias(4)+"; nhand: "+alltrim(str(nHand))+"; select(nomebase): "+alltrim(str(select(nomebase)))+"; tamanho da base: "+alltrim(str(filesize(nomebase))))
endif
@ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
@ maxrow()-1,1 say "Base "+upper(nomebase)+" ocupada; aguarde liberação ("+alltrim(str(vezusb))+")"
if us="I"
@ maxrow(),1 say "Área: "+alltrim(str(select()))+"; aliás1: "+alias(1)+"; aliás2: "+alias(2)+"; aliás3: "+alias(3)+"; aliás4: "+alias(4)+"; select(nomebase): "+alltrim(str(select(nomebase)))
endif
inkey(8)
@ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
desiste:=inkey(8)
if desiste= 27 //K_ESC
conf="N"
@ maxrow()-2,1 clear to maxrow(),79
@ maxrow()-1,5 say "Confirma abandono da tentativa da utilização?"get conf pict "@!"
read
@ maxrow()-2,1 clear to maxrow(),79
if conf="S"
return .f.
endif
endif
else
exit
endif
else
if us="I" .and. at("ATEMP",upper(nomebase))=0
@ 1,1 clear to 23,79
@ 11,5 say "Base "+nomebase+" inexistente"
@ 12,5 say "Bssembarra: "+bssembarra
@ 13,5 say "Pasta corrente: "+curdir()
@ 14,5 say "Função chamadora: "+procname(1)
@ 15,5 say "Linha: "+alltrim(str(procline(1)))
tone(261.7,33)
inkey(15.5)
endif
return .f.
endif
enddo
return .t.
function mandmail1(arqmand,assmail,arqanx,inc)
nsec=0
@ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
@ maxrow()-1,1 say "Aguarde..."
if inc=2
dstmail="ibcneto"
else
dstmail="inacio"
endif
nrarea=select()
sele 4
if usebase("\tarefas\numeros")=.t. .and. procname(1)#"VERPROCV"
if (assmail==assultm .and. substr(time(),1,2)==hrultm) .or. (assmail=asspenm .and. substr(time(),1,2)==hrpenm)
if usebase("\tarefas\"+ativ)=.t.
a=1
b=1
do while .t.
append blank
if rlbs()
repl data with date()
repl hora with time()
repl acao with "Mandm1-igual"
repl nrtarefa with substr(hb_progname(),a,6)
repl assunto with substr(assmail,b,16)
endif
a=a+6
b=b+216
if empty(substr(hb_progname(),a,6)) .and. empty(substr(assmail,b,16))
exit
endif
enddo
endif
use
sele (nrarea)
return
else
asspenm=assultm
assultm=assmail
hrpenm=hrultm
hrultm=substr(time(),1,2)
if rlbs()=.t.
repl asspenmail with assultmail
repl hrpenmail with hrultmail
repl assultmail with assultm
repl hrultmail with hrultm
endif
endif
endif
use
sele (nrarea)
if upper(procname(1))="VERMAIL"
cMessage=arqmand
else
nCols := MaxCol()
nRows := MaxRow()
nStart := 1
cScreen := Savescreen()
cMessage = "Vídeo Screen Dump:" + Hb_Eol()
cMessage += Replicate( '-', nCols +3 ) + Hb_Eol()
nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
nRange := ( nCols + 1 ) * nCellSize
For nCount := 1 To nRows + 1
cOutString := ''
cSubString := Substr( cScreen, nStart, nRange )
For nForLoop := 1 To nRange step nCellSize
cOutString += Substr( cSubString, nForLoop, 1 )
Next
cMessage += "|" + cOutString + "|" + Hb_Eol()
nStart += nRange
Next
cMessage += Replicate( '-', nCols +3 ) + Hb_Eol()
endif
assmail=ansi(alltrim(nmus)+": "+assmail) //+"; versão:"+vers+"; proc1: "+procname(1)+" ("+alltrim(str(procline(1)))+"); proc2: "+procname(2)+" ("+alltrim(str(procline(2)))+"); proc3: " +procname(3)+" ("+alltrim(str(procline(3)))+"); máquina: "+netname())
if arqmand="error.log" .and. file("error.log")
contmail=""
else
contmail=hb_eol()+"Programa...: "+hb_progname();
+hb_eol()+"Versão.....: "+vers+hb_eol();
+hb_eol()+"Máquina....: "+netname();
+hb_eol()+"Pasta atual: "+curdir()+hb_eol();
+hb_eol()+"Proc1......: "+procname(1)+" ("+alltrim(str(procline(1)))+")"+hb_eol();
+if(!empty(procname(2)),"Proc2......: "+procname(2)+" ("+alltrim(str(procline(2)))+")"+hb_eol(),"");
+if(!empty(procname(3)),"Proc3......: "+procname(3)+" ("+alltrim(str(procline(3)))+")"+hb_eol(),"");
+if(!empty(procname(4)),"Proc4......: "+procname(4)+" ("+alltrim(str(procline(4)))+")"+hb_eol(),"");
+if(!empty(procname(5)),"Proc5......: "+procname(5)+" ("+alltrim(str(procline(5)))+")"+hb_eol(),"");
+if(!empty(procname(6)),"Proc6......: "+procname(6)+" ("+alltrim(str(procline(6)))+")"+hb_eol(),"");
+if(!empty(procname(7)),"Proc7......: "+procname(7)+" ("+alltrim(str(procline(7)))+")"+hb_eol(),"");
+if(!empty(procname(8)),"Proc8......: "+procname(8)+" ("+alltrim(str(procline(8)))+")"+hb_eol(),"");
+if(!empty(procname(9)),"Proc9......: "+procname(9)+" ("+alltrim(str(procline(9)))+")"+hb_eol(),"");
+if(!empty(procname(10)),"Proc10.....: "+procname(10)+" ("+alltrim(str(procline(10)))+")"+hb_eol(),"");
+if(!empty(procname(11)),"Proc11.....: "+procname(11)+" ("+alltrim(str(procline(11)))+")"+hb_eol(),"");
+if(!empty(procname(12)),"Proc12.....: "+procname(12)+" ("+alltrim(str(procline(12)))+")"+hb_eol(),"");
+if(!empty(procname(13)),"Proc13.....: "+procname(13)+" ("+alltrim(str(procline(13)))+")"+hb_eol(),"");
+if(!empty(procname(14)),"Proc14.....: "+procname(14)+" ("+alltrim(str(procline(14)))+")"+hb_eol(),"");
+if(!empty(procname(15)),"Proc15.....: "+procname(15)+" ("+alltrim(str(procline(15)))+")"+hb_eol(),"");
+hb_eol()+"Área em uso: "+alltrim(str(select()))+hb_eol();
+"Área 1.....: " + alias(1) + Hb_Eol();
+if(!empty(alias(2)),"Área 2.....: "+alias(2)+Hb_Eol(),"");
+if(!empty(alias(3)),"Área 3.....: "+alias(3)+Hb_Eol(),"");
+if(!empty(alias(4)),"Área 4.....: "+alias(4)+Hb_Eol(),"");
+if(!empty(alias(5)),"Área 5.....: "+alias(5)+Hb_Eol(),"");
+if(!empty(alias(6)),"Área 6.....: "+alias(6)+Hb_Eol(),"");
+if(!empty(alias(7)),"Área 7.....: "+alias(7)+Hb_Eol(),"");
+if(!empty(alias(8)),"Área 8.....: "+alias(8)+Hb_Eol(),"");
+if(!empty(alias(9)),"Área 9.....: "+alias(9)+Hb_Eol(),"");
+"Nrarea.....: "+alltrim(str(nrarea));
+hb_eol()+"Data.......: "+dtoc(date());
+hb_eol()+"Hora.......: "+time();
+hb_eol()+hb_eol()+cMessage+hb_eol()
endif
if hb_sendmail("smtp.xxx.com.br",587,"programa@inaciocarvalho.com.br",{dstmail+"@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"programa@inaciocarvalho.com.br","xxx","pop3.xxx.com.br",,,.T.,.t.,,,)=.f.
if verint()=.f.
if at("VERMAIL",procname(1))=0 .and. at("VERMAIL",upper(procname(2)))=0 .and. at("VERMAIL",upper(procname(3)))=0
if type("arqanx")="U"
arqanx=""
endif
endif
return .f.
endif
if hb_sendmail("smtp.expressomx03.pr.gov.br",465,alltrim(nmus)+"@mp.pr.gov.br",{dstmail+"@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"ibcneto","xxx","imap.expressomx03.pr.gov.br",,,.T.,.t.,,,)=.f.
if hb_sendmail("smtp.onda.com.br",587,"inaciocarvalho@onda.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"inaciocarvalho","xxx","pop3.onda.com.br",,,.T.,.t.,,,)=.f.
if hb_sendmail("smtp.inaciocarvalho.com.br",587,"inacio@inaciocarvalho.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"inacio@inaciocarvalho.com.br","xxx","pop3.inaciocarvalho.com.br",,,.T.,.t.,,,)=.f.
if hb_sendmail("smtp.inaciocarvalho.com.br",587,"inaciocarvalho@inaciocarvalho.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"inaciocarvalho@inaciocarvalho.com.br","xxx","pop3.inaciocarvalho.com.br",,,.T.,.t.,,,)=.f.
if hb_sendmail("smtp.inaciocarvalho.com.br",587,"programa@inaciocarvalho.com.br",{"inacio@inaciocarvalho.com.br"},,,memoread(arqmand)+ansi(contmail),assmail,arqanx,"programa@inaciocarvalho.com.br","xxx","pop3.inaciocarvalho.com.br",,,.T.,.t.,,,)=.f.
__run("smtpsend -@mailv.txt -s" + assmail + " >result.txt")
if file("result.txt")
if type("arqanx")="U"
arqanx=""
endif
endif
endif
return .f.
endif
endif
endif
endif
endif
@ maxrow()-1,1 clear to maxrow()-1,15
return .t.
function pargerais
if "AG"$upper(hb_progname()) .or. "COPYP"$upper(hb_progname())
public nmus :="Inacio"
public ptreceb :="inacio"
public ativ :="ativi"
public us :="I"
else
public ptreceb :=""
endif
if us="I" .or. us="H"
public seis :=""
endif
if valtype("usooff")#"U"
public usooff :="N"
endif
public fAtiva :=.t.
public vzidle :=0
public erecftp :="" //recebftp
public vzerr :=0
public tarfaz :="nada"
public vzresp2 :=0
public hrintar :=0
public vztpexc :=0
public assultm :=""
public hrultm :=""
public asspenm :=""
public hrpenm :=""
public snhftp :="Dani2013"
public ftps :="ftp.inaciocarvalho.com.br"
public ptftp :="/inaciobr/"
public usftp :="inaciobr"
public tarord :="S"
public nrvzatind :=0
public pratual :=0
public temkill :=0
public nsec :=0
public optar :=0
public cpdrod :="\\rodrigo-pc\c\"
public cpdcam :="\\192.168.100.13\c\"
public assultm :=""
SET WRAP ON
SET ESCAPE ON
SET TALK OFF
SET BELL OFF
SET DATE BRIT
set scor off
set epoc to 1950
return
function edbase
private exp :=space(15)
save scre to tledb
@ 10,1 clear to 33,69
@ 10,1 to 33,69 double
bs=space(48)
set key 28 to abrearq
set cursor on
do while .t.
if usebase("\tarefas\ultedit")=.t.
index on dtos(data)+hora to indult descend
go top
@ 18,3 say "Últimos abertos:"
@ 19,3 say arquivo
skip
@ 20,3 say arquivo
skip
@ 21,3 say arquivo
skip
@ 22,3 say arquivo
skip
@ 23,3 say arquivo
skip
@ 24,3 say arquivo
skip
@ 25,3 say arquivo
skip
@ 26,3 say arquivo
skip
@ 27,3 say arquivo
skip
@ 28,3 say arquivo
skip
@ 29,3 say arquivo
skip
@ 30,3 say arquivo
skip
@ 31,3 say arquivo
skip
@ 32,3 say arquivo
endif
use
set key 24 to escbased
bs=bs+space(10)
@ 15,2 say "Para listar arquivos, tecle F1; para escolher entre os"
@ 16,2 say "últimos arquivos abertos, tecle seta para baixo"
@ 11,2 say "Pasta atual: "+curdir()
@ 13,2 say "Arquivo:"get bs
read
set key 24 to
set key 28 to
set key -1 to
if lastkey()=27
exit
endif
if !file("\tarefas\ultedit.dbf")
nvestr := {}
aadd(nvestr,{"arquivo","C", 40, 0})
aadd(nvestr,{"data","D", 08, 0})
aadd(nvestr,{"hora","C", 05, 0})
dbcreate("ultedit",nvestr)
endif
if usebase("\tarefas\ultedit")=.t.
locate for arquivo=bs
if !found()
append blank
rlbs()
replace arquivo with bs
endif
replace data with date()
replace hora with time()
endif
if us#"I"
?us
if usebase(ativ)=.t.
append blank
rlbs()
replace data with date()
replace hora with time()
replace acao with "Edbase"
replace assunto with bs
endif
use
endif
if lastkey()#27
if "\\promotor"$bs .and. !file("\\promotor\c\lixo\copypen.dbf")
tone(261.7,3)
clear
@ 5,5 say "Atenção: não alterar este arquivo hoje"
inkey(10)
tone(261.7,22)
inkey(5)
endif
bs=alltrim(bs)
if !file((bs)+".dbf")
@ 20,5 say "Arquivo inexistente"
inkey(5)
rest scre from tledb
loop
endif
__run("copy "+bs+".dbf \lixo")
if usebase(bs,"S")=.T.
keysec()
cls
@ 0,1 say "Arquivo em edição: "+alias()
@ maxrow(),1 say "Alt-P-procura/filtra; Alt-M-mostra estrutura; F2-acresce registros; Alt-C-conta registros"
keyb chr(20)
dbedit(2,1,maxrow()-2,maxcol(),,"altbase")
* pack
else
@ maxrow()-1,5 say "Abandonado"
inkey(15)
endif
exit
endif
enddo
rest scre from tledb
use
return
function rlbs
local nrrl :=0
if empty(alias())
return .f.
endif
do while .t.
if rlock()=.t.
exit
else
nrrl++
@ maxrow()-1,1 say "Aguarde tentativa de reservar o registro da base "+alias()+" para uso privado ("+alltrim(str(nrrl))+")"
inkey(5)
if nrrl>50
return .f.
endif
endif
enddo
return .t.
function ANSI(cTxt) // 1 texto a ser convertido para o padrÒo ANSI
local I
local aTab
local nCod
aTab:= {;
199,252,233,226,228,224,229,231,234,235,232,239,238,236,196,197,;
201,230,198,244,246,242,251,249,255,214,220,248,163,216,215,131,;
225,237,243,250,241,209,170,176,191,174,172,189,188,161,171,187,;
35, 35, 35,124, 43,193,194,192,169, 43,124, 43, 43,162,165, 43,;
43, 43, 43, 43, 45, 43,227,195, 43, 43, 43, 43, 43, 61, 43,164,;
240,208,202,203,200,185,205,206,207, 43, 43, 35, 35,166,204, 35,;
211,223,212,210,245,213,181,254,222,218,219,217,253,221,175,180,;
173,177, 61,190,182,167,247,184,186,168,183,185,179,178, 35, 32 }
for I:= 1 to Len(cTxt)
nCod:= ASC(SubStr(cTxt,I,1))
if nCod >= 128
cTxt:= Stuff(cTxt,I,1,Chr(aTab[nCod -127]))
endif
next
return cTxt
function verint
local nFlags := 0, lRet := .f.
erase lista.log
pasta=ptftp+"tarefas/inacio"
if listaftp(ptftp)=.t.
return .t.
else
**********************************************
* Compilar: hbmk2 demo.prg -lhbmisc
**********************************************
if CallDll32( "InternetGetConnectedState", "WININET.DLL", @nFlags, 0 ) == 1
return .t.
else
return .f.
endif
endif
return
function abrearq
set key 24 to
save scre to tlabarq
Public aFiles[ADIR("*.DBF")]
ADIR("*.DBF",aFiles)
@ 6,24 to 21,65 double
aSort(aFiles)
nArquivo:=Achoice(7,25,20,64,aFiles)
if lastkey()=27
return .f.
endif
Cls
bs=aFiles[nArquivo]
set key 24 to escbased
rest scre from tlabarq
return
FUNCTION escbased
set key 24 to
if usebase("\tarefas\ultedit")=.t.
index on dtos(data)+hora to indult descend
private v1[1]
v1[1]="Arquivo"
@ 19,0 clear to 33,45
dbedit(19,3,32,43,v1)
bs=arquivo
endif
@ 19,0 clear to 33,45
RETURN
Function listaftp(pasta)
ftpproto ="ftp://" //posthilit">ftp://"
ftpserver = ftps // posthilit">ftp.servidor.com.br" endereço de ="posthilit">FTP</span> do site
ftpuser = "inaciobr" //Usuário da conta ="posthilit">FTP</span>
curl:=ftpproto+ftpuser+":"+snhftp+"@"+ftpserver
oUrl:= turl():new(curl)
oCred:= tIPCredentials()
oFtp:= tipclientftp():NEW(oUrl,.T.)
oFTP:nConnTimeout := 20000
oFTP:bUsePasv := .T.
pasta=alltrim(pasta)
nTentativas=0
do while .t.
IF oFTP:Open()
exit
else
nTentativas++
@ maxrow()-1,1 clear to maxrow()-1,maxcol()-1
@ maxrow()-1,1 say "Tentando abrir o FTP (listaftp)"
if us="I" .and. (nTentativas=3 .or. nTentativas>8)
tone(261.7,nTentativas)
endif
inkey(28)
if nTentativas>10 .or. usooff="S"
mandmail1("","Não abriu o FTP no listaftp")
return .f.
endif
endif
enddo
nTentativas := 0
oFTP:Cwd( "" )
While oFTP:Cwd(pasta)=.f.
oFTP:pwd()
if us="I"
@ maxrow()-1,1 say "Não conseguiu abrir a pasta do FTP; tentando novamente"
?oftp:creply
if nTentativas>3
tone(261.7,nTentativas)
endif
endif
InKey( 11.5 ) // aguarda 1/2 segundo
nTentativas++
If nTentativas > 10 // após 3 tentativas p.e.
if us="I"
cls
?"Conferir pasta: "+pasta
tone(261.7,33)
endif
mandmail1("","Conferir pasta no listaftp: "+pasta+"; "+oFTP:cReply)
return .f.
EndIf
EndDo
nTentativas=0
do while .t.
clista:=oFTP:List()
if valtype(clista)="U"
nTentativas++
if us="I" .and. nTentativas>3
@ maxrow()-1,1 say "Clista está indefinida no listaftp"
tone(261.7,nTentativas)
inkey(10)
endif
if nTentativas>10
mandmail1("","Clista indefinido com valtype")
return .f.
endif
else
exit
endif
enddo
if usebase("arqbx","S")=.t.
dele all
pack
clista=substr(clista,40)
do while .t.
if empty(clista) .or. at("www.ina",clista)=1
exit
endif
nrfinal=at(".",substr(clista,1,10))+3
if at(".",substr(clista,nrfinal,5))=0
append blank
repl nome with substr(clista,1,nrfinal)
else
nrfinal=nrfinal+4
endif
clista=substr(clista,nrfinal+42)
if len(clista)<5
exit
endif
enddo
else
if usebase(ativ)
append blank
repl data with date()
repl hora with time()
repl acao with "Ñ abre"
repl nrtarefa with "arqbx"
repl assunto with "na listaftp"
endif
use
return .f.
ENDIF
oFTP:cwd( "" )
oFTP:Close()
Return .t.
Está compilando, e está conectando no banco de dados, mas daí dá erro no dbf: