Valida RFC

 // Summary: <specify the procedure action>

// Syntax:

//[ <Result> = ] GP_ValidaRFC (<nTipoPersona>, <sParamRFC>)

//

// Parameters:

// nTipoPersona: 

// sParamRFC: <specify the role of sRFC>

PROCEDURE GP_ValidaRFC(nTipoPersona,sParamRFC)

sRFC is string = sParamRFC

bValidaRFC is boolean = False

sLetra is string

sVerifica is string

sDigito is string = Right(sRFC,1)

nContador is int

nValor is int

nSuma is int = 0

nModulo11 is int

IF nTipoPersona = 1 THEN

IF Length(sRFC) = 13 THEN

bValidaRFC = True

END

ELSE

IF Length(sRFC) = 12 THEN

bValidaRFC = True

END

END

IF bValidaRFC = True THEN

IF Length(sRFC) = 12

sRFC = " " + sRFC  

END

FOR nContador = 1 TO 12

sLetra = sRFC[nContador] 

SWITCH sLetra

CASE "0": nValor = 0

CASE "1": nValor = 1

CASE "2": nValor = 2

CASE "3": nValor = 3

CASE "4": nValor = 4

CASE "5": nValor = 5

CASE "6": nValor = 6

CASE "7": nValor = 7

CASE "8": nValor = 8

CASE "9": nValor = 9

CASE "A": nValor = 10

CASE "B": nValor = 11

CASE "C": nValor = 12

CASE "D": nValor = 13

CASE "E": nValor = 14

CASE "F": nValor = 15

CASE "G": nValor = 16

CASE "H": nValor = 17

CASE "I": nValor = 18

CASE "J": nValor = 19

CASE "K": nValor = 20

CASE "L": nValor = 21

CASE "M": nValor = 22

CASE "N": nValor = 23

CASE "&": nValor = 24

CASE "O": nValor = 25

CASE "P": nValor = 26

CASE "Q": nValor = 27

CASE "R": nValor = 28

CASE "S": nValor = 29

CASE "T": nValor = 30

CASE "U": nValor = 31

CASE "V": nValor = 32

CASE "W": nValor = 33

CASE "X": nValor = 34

CASE "Y": nValor = 35

CASE "Z": nValor = 36

CASE " ": nValor = 37

CASE "Ñ": nValor = 38

OTHER CASE

END

nSuma = nSuma + ((14-nContador)*nValor)

END

nSuma = 11000 - nSuma

nModulo11 = modulo(nSuma, 11)

IF nModulo11 = 10 THEN

sVerifica = "A"

ELSE

sVerifica = nModulo11

END

IF sVerifica <> sDigito THEN

bValidaRFC = False

END

END

RESULT bValidaRFC

Try catch end

 // --------------------------------------------------
// Procedure principal que executa uma query com tratamento de exceção
// --------------------------------------------------
PROCEDURE ExecutarConsultaComTratamento()
sSQL is string = "SELECT * FROM cliente WHERE cidade = 'Curitiba'"
TRY
   IF NOT HExecuteSQLQuery(MyQuery, hQueryDefault, sSQL) THEN
      // Se a query falhar, forçamos uma exceção manual
      Error("Erro na consulta")
      ExceptionThrow(HError()) // Dispara a exception com o código de erro
   END
   // Continua a execução se der certo
   HReadFirst(MyQuery)
   WHILE NOT HOut()
      Trace(MyQuery.Nome + " - " + MyQuery.Email)
      HReadNext(MyQuery)
   END
CATCH (ErroBD)
   Info("Erro capturado via exceção: " + FazerAcaoCasoErro(ErroBD))
END

WHEN EXCEPTION IN

 PROCEDURE ValeurChamp(sNomChamp)
WHEN EXCEPTION IN
 RETURN (sNomChamp)
DO
 IF ExceptionInfo(errCode) = ExIDInconnu THEN 
RETURN ""
End 
END

/////////////

// Procedure : InserirClienteComTransacao

// Objetivo  : Inserir cliente e endereço com transação segura

// Autor     : Adriano Boller - WX Soluções

// --------------------------------------------------

PROCEDURE InserirClienteComTransacao()

// Dados de exemplo

sNome        is string = "Maria Silva"

sEmail       is string = "maria@exemplo.com"

sEndereco    is string = "Rua Exemplo, 123"

sCidade      is string = "Curitiba"

TRY

   // Inicia transação

   HTransactionStart()

   // Inserir cliente

   cliente.Nome  = sNome

   cliente.Email = sEmail

   IF NOT HAdd(cliente) THEN

      ExceptionThrow(HError()) // dispara erro se falhar

   END

   // Inserir endereço (relacionado ao cliente recém-inserido)

   endereco.IDCliente = HRecNum(cliente)

   endereco.Logradouro = sEndereco

   endereco.Cidade     = sCidade

   IF NOT HAdd(endereco) THEN

      ExceptionThrow(HError())

   END

   // Se tudo deu certo, confirmamos a transação

   HTransactionCommit()

   Info("Cliente e endereço inseridos com sucesso!")

CATCH(ErroTransacao)

   // Se qualquer erro acontecer, desfaz tudo

   HTransactionCancel()

   Error("Erro ao inserir dados: " + InterpretarErroHFSQL(ErroTransacao))

END

Manejo de errores al modificar tablas

//adriano boller

//Modo de usar

If hadd(tabela) = false

    FazerAcaoCasoErro()

End 

FazerAcaoCasoErro()

PROCEDURE FazerAcaoCasoErro() 

Info("Algo deu errado", HErrorInfo(), ErrorInfo())

SWITCH HError()

CASE 70001

info( "Erro ao abrir a conexão com o banco de dados. Verifique se o servidor está disponível.")

              //Execute70001

CASE 70002

info( "Erro de autenticação. Usuário ou senha inválidos.")

              //Execute70002

CASE 70003

info( "Erro ao executar a query. Verifique a sintaxe SQL.")

              //Execute70003

CASE 70004

info( "A tabela referenciada não foi encontrada no banco de dados.")

              //Execute70004

CASE 70005

info "Violação de integridade referencial (chave estrangeira ou primária).")

               //Execute70005

CASE 70006

info( "Tentativa de inserir um registro duplicado (chave única).")

               //Execute70006

CASE 70007

info( "Erro ao acessar o arquivo de dados (possível corrupção ou ausência).")

              //Execute70007

CASE 70008

info( "Problema ao gravar no banco de dados. Verifique espaço em disco ou permissões.")

               //Execute70008

CASE 70009

info( "Erro de bloqueio. O registro já está sendo usado por outro processo.")

  //Execute70009

CASE 70010

info( "O campo solicitado não existe na estrutura da tabela.")

               //Execute70010

CASE 70011

info( "Problema na transação. Pode ser necessário usar HTransactionCancel().")

                //Execute70011

CASE 70012

info( "Erro de comunicação com o banco. Verifique a rede ou timeouts.")

              //Execute70012

OTHER CASE

info( "Erro desconhecido” + HErrorInfo())

END

ZIP

CÓDIGO DE ADRIANO BOLLER

//Generar un archivo zip
sArquivoZip is string = fCurrentDir() + "\backup_projeto.zip"
// Caminho da pasta a ser compactada
sPasta is string = fCurrentDir() + "\projeto_completo"
// Se o ZIP já existe, remove
IF fFileExist(sArquivoZip) THEN
    fDelete(sArquivoZip)
END
// Cria o arquivo ZIP
IF NOT zipCreate(sArquivoZip) THEN
    Error("Error criar o arquivo zip: " + zipMsgError())
    RETURN
END
// Adiciona a pasta inteira recursivamente
IF NOT zipAddDirectory(sArquivoZip, sPasta, zipDirectoryRecursive) THEN
    Error("Erro ao adicionar pasta ao zip: " + zipMsgError())
    zipClose(sArquivoZip)
    RETURN
END
// Fecha o arquivo zip após adicionar tudo
zipClose(sArquivoZip)
// Confirmação
Info("Backup compactado com sucesso: " + sArquivoZip)

//

// Procedure: ZipAllFilesInFolder

// Finalidade: Adiciona todos os arquivos de uma pasta no arquivo ZIP

PROCEDURE ZipAllFilesInFolder(sZipFileName is string, sFolderPath is string)

MyArchive is zipArchive

ResOpen is boolean

ResAddFile is boolean

sFileList is array of strings

sCurrentFile is string

// Abre o arquivo ZIP para criação

ResOpen = zipCreate(MyArchive, sZipFileName)

IF NOT ResOpen THEN

   Error("Erro ao criar arquivo ZIP:", zipMsgError(MyArchive))

   RETURN

END

// Garante que o caminho termina com "\"

IF Right(sFolderPath, 1) <> "\" THEN

   sFolderPath += "\"

END

// Lista todos os arquivos na pasta (não inclui subpastas)

sFileList = fListFile(sFolderPath + ".", frFile)

// Loop para adicionar cada arquivo individualmente

FOR EACH sCurrentFile OF sFileList

   // Adiciona o arquivo no ZIP

   ResAddFile = zipAddFile(MyArchive, sFolderPath + sCurrentFile, zipDrive)

   

   IF NOT ResAddFile THEN

      Error("Erro ao adicionar arquivo: " + sCurrentFile + " - " + zipMsgError(MyArchive))

   END

END

// Fecha o arquivo ZIP

zipClose(MyArchive)

// Mensagem de sucesso

Info("Todos os arquivos foram adicionados ao ZIP com sucesso!")

XML

 XML es UTF8,

Basándonos en este discurso, generamos el XML y lo lanzamos en una cadena

En este momento hice otra variable variavel_xml es buffer = stringtoutf8(string_xml_ansi)

listo..

Ejecutó el 100% del xml. Ya se está validando

y la compactación que también estaba dando problemas. Agregué zipansi al final del comando

nZipFile is int = zipCreate("ZipFile", :m_sEndereco_Arquivo_zip,zipAnsi)

Consulta de indicadores financieros BM

 cyValor is currency

sFecha is string = DateToString(dParamFecha,"YYYY-MM-DD")

sCadena is string = "https://www.banxico.org.mx/SieAPIRest/service/v1/series/SF43783/datos/%1/%2"

sUrl is string = StringBuild(sCadena,sFecha,sFecha)

Consulta is httpRequest

Consulta.Reset()

Consulta.Method = httpGet

Consulta.URL = sUrl            // "https://www.banxico.org.mx/SieAPIRest/service/v1/series/SF43718/datos/2023-10-01/2023-11-16"

Consulta.Header["Bmx-Token"] = "ea27d86f0ea63ff49e40c0fb4097e93f75b5471c23786045935de06b50b"

Consulta.ContentType = typeMimeJSON

//https://www.banxico.org.mx/SieAPIRest/service/v1/series/SP74665,SF61745,SF60634,SF43718,SF43773/datos/2015-01-01/2015-01-08

Respuesta is restResponse = RESTSend(Consulta)

IF Respuesta.StatusCode = 200 THEN

BuffJSON is JSON = Respuesta.Content

FOR EACH ResultadoJSON OF BuffJSON

//Info(ResultadoJSON.series)

FOR EACH Series OF ResultadoJSON.series

//Info(Series.datos)

FOR EACH Datos OF Series.datos

//Info(Datos.fecha)

cyValor = Datos.dato

END

END

END

ELSE

Error("Error al procesar la solicitud","Codigo del error:" + Respuesta.StatusCode, "descripción del error: " + Respuesta.DescriptionStatusCode)

END

RESULT cyValor