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

Formateando una tabla (browse)

 

//Desplegando un renglón

IF COL_Estatus = 20 THEN

TABLE_DB_Inv_Inversion[TABLE_DB_Inv_Inversion]..Color = DarkGreen

TABLE_DB_Inv_Inversion[TABLE_DB_Inv_Inversion]..FontBold = True

TABLE_DB_Inv_Inversion[TABLE_DB_Inv_Inversion]..FontSize = 9

ELSE IF COL_Estatus = 15 THEN

TABLE_DB_Inv_Inversion[TABLE_DB_Inv_Inversion]..Color = LightRed

TABLE_DB_Inv_Inversion[TABLE_DB_Inv_Inversion]..FontBold = True

TABLE_DB_Inv_Inversion[TABLE_DB_Inv_Inversion]..FontSize = 9

END

SINCRONIZAR HORARIO CON HORA DEL SERVIDOR

 //SINCRONIZA HORARIO COM A HORA DO SERVIDOR  //ADRIANO BOLLER

PathFile is string = fCurrentDir ( fCurrentDrive() ) +"\config.ini"

IF CBOX_Sincronizar..Value = True THEN
Sincronizar = "S"
ok is boolean = INIWrite("Nagyro", "Sincronizar", Sincronizar , PathFile)
IF ErrorOccurred = True AND Sincronizar = "" THEN
Error()
END
ELSE
Sincronizar = "N"
ok is boolean = INIWrite("Nagyro", "Sincronizar", Sincronizar , PathFile)
IF ErrorOccurred = True AND Sincronizar = "" THEN
Error()
END
END

IF Sincronizar = "S" THEN
ExeRun("NET TIME \\192.168.1.180 /SET /YES",exeIconize,exeDontWait)
END

Número a letras 2

Código números a letras desde Windev – Recursos Windev Webdev y Windev Mobile (wordpress.com)

PROCEDURE entero_a_letras(numero)
nEntero is int
nTemporal is int
sLetras is string
nEntero = numero
SWITCH nEntero
    CASE 0 : sLetras = "CERO"
    CASE 1 : sLetras = "UN"
    CASE 2 : sLetras = "DOS"
    CASE 3 : sLetras = "TRES"
    CASE 4 : sLetras = "CUATRO"
    CASE 5 : sLetras = "CINCO"
    CASE 6 : sLetras = "SEIS"
    CASE 7 : sLetras = "SIETE"
    CASE 8 : sLetras = "OCHO"
    CASE 9 : sLetras = "NUEVE"
    CASE 10 : sLetras = "DIEZ"
    CASE 11 : sLetras = "ONCE"
    CASE 12 : sLetras = "DOCE"
    CASE 13 : sLetras = "TRECE"
    CASE 14 : sLetras = "CATORCE"
    CASE 15 : sLetras = "QUINCE"
    CASE < 20 : sLetras = "DIECI" + entero_a_letras(nEntero - 10)
    CASE 20 : sLetras = "VEINTE"
    CASE < 30 : sLetras = "VEINTI" + entero_a_letras(nEntero - 20)
    CASE 30 : sLetras = "TREINTA"
    CASE 40 : sLetras = "CUARENTA"
    CASE 50 : sLetras = "CINCUENTA"
    CASE 60 : sLetras = "SESENTA"
    CASE 70 : sLetras = "SETENTA"
    CASE 80 : sLetras = "OCHENTA"
    CASE 90 : sLetras = "NOVENTA"
    CASE < 100 :
        nTemporal = nEntero / 10
        nTemporal = nTemporal * 10
        sLetras = entero_a_letras(nTemporal) + "  Y  " + entero_a_letras(nEntero-nTemporal)
    CASE 100 : sLetras = "CIEN"
    CASE < 200 : sLetras = "CIENTO " + entero_a_letras(nEntero - 100)
    CASE 200, 300, 400, 600, 800 : sLetras = entero_a_letras(nEntero/100) + "CIENTOS"
    CASE 500 : sLetras = "QUINIENTOS"
    CASE 700 : sLetras = "SETECIENTOS"
    CASE 900 : sLetras = "NOVECIENTOS"
    CASE < 1000 :
        nTemporal = nEntero / 100
        nTemporal = nTemporal * 100
        sLetras = entero_a_letras(nTemporal) + " " + entero_a_letras(nEntero-nTemporal)
    CASE 1000 : sLetras = "MIL"
    CASE < 2000 : sLetras = "MIL " + entero_a_letras(nEntero-1000)
    CASE < 1000000 :
        sLetras = entero_a_letras(nEntero/1000) + " MIL"
        nTemporal = nEntero / 1000
        nTemporal = nTemporal * 1000
        nTemporal = nEntero - nTemporal
        IF nTemporal < 1000 AND nTemporal > 0 THEN
            sLetras = sLetras + "  " + entero_a_letras(nTemporal)
        END
    CASE 1000000 : sLetras = "UN MILLON"
    CASE < 2000000 : sLetras = "UN MILLON " + entero_a_letras(nEntero - 1000000)
    CASE < 1000000000000 :
        sLetras = entero_a_letras(nEntero/1000000) + " MILLONES"
        nTemporal = nEntero / 1000000
        nTemporal = nTemporal * 1000000
        nTemporal = nEntero - nTemporal
        IF nTemporal < 1000000 AND nTemporal > 0 THEN
            sLetras = sLetras + "  " + entero_a_letras(nTemporal)          
        END
END
RESULT sLetras

PROCEDURE centavos_a_letras(numero)
sCentavos is string
xDecimales is numeric
 
 
xDecimales = DecimalPart(numero)
xDecimales = xDecimales * 100
 
 
IF xDecimales = 0 THEN
    sCentavos = " PESOS 00/100 M.N."
ELSE
    IF xDecimales < 10 THEN
        sCentavos = " PESOS 0" + xDecimales + "/100 M.N."
    ELSE
        sCentavos = " PESOS " + xDecimales + "/100 M.N."
    END
END
RESULT sCentavos

Conexión BD MySQL

Instalar

wd240msql64.DLL

libmysql.dll

en

C:\PC SOFT\WINDEV 24\Programs\Framework\Win64x86

y también en el ejecutable

 IF InTestMode() = True THEN
////*******************************************************************
MiConTest is Connection   //conexión de pruebas
MiConTest..User = "supervisor"
MiConTest..Password = "supervisor"
MiConTest..Server = "localhost"
MiConTest..Database = "FarmaWD"
MiConTest..Provider = hNativeAccessMySQL
MiConTest..Access = hOReadWrite
MiConTest..ExtendedInfo = "Extended information"
MiConTest..CursorOptions = hClientCursor
MiConTest..Caption               = "AMBIENTE DE PRUEBAS"
HOpenConnection(MiConTest)   // Open the connection
HChangeConnection("*", MiConTest) // Assign the connection to all data files
ELSE
MiConFarma is Connection   //conexión de produccion
MiConFarma..User = "supervisor"
MiConFarma..Password = "supervisor"
MiConFarma..Server = "localhost"
MiConFarma..Database = "FarmaWD"
MiConFarma..Provider = hNativeAccessMySQL
MiConFarma..Access = hOReadWrite
MiConFarma..ExtendedInfo = "Extended information"
MiConFarma..CursorOptions = hClientCursor
MiConFarma..Caption        = "AMBIENTE DE PRODUCCION"
HOpenConnection(MiConFarma)   // Open the connection
HChangeConnection("*", MiConFarma) // Assign the connection to all data files
END

Crear Excel

 MyWorksheet is xlsDocument

xlsAddWorksheet(MyWorksheet, "R04_C-0451")

//MyWorksheet = xlsOpen(sNombreArchivoXLS, xlsWrite)

xlsCurrentWorksheet(MyWorksheet, 1)

nColumna is int 

nRenglon is int = 1

FOR nColumna = 1 TO 15

MyWorksheet[nRenglon,nColumna]..BackgroundColor = LightYellow

MyWorksheet[nRenglon,nColumna]..Border..LineTop..Thickness = 3

MyWorksheet[nRenglon,nColumna]..Border..LineBottom..Thickness = 3

MyWorksheet[nRenglon,nColumna]..Font..Bold = True

MyWorksheet[nRenglon,nColumna]..AlignmentH = haCenter

MyWorksheet[nRenglon,nColumna]..AlignmentV = vaMiddle

MyWorksheet[nRenglon,nColumna] = nColumna

END

nRenglon++

MyWorksheet[nRenglon,03] = "NUMERO DE REPORTE"

MyWorksheet[nRenglon,04] = "NUMERO DE SOCIO"

MyWorksheet[nRenglon,05] = "TIPO DE SOCIO"

MyWorksheet[nRenglon,06] = "NOMBRE O DENOMINACION SOCIAL DEL ACREDITADO"

MyWorksheet[nRenglon,07] = "APELLIDO PATERNO DEL ACREDITADO"

MyWorksheet[nRenglon,08] = "APELLIDO MATERNO DEL ACREDITADO"

MyWorksheet[nRenglon,09] = "PERSONALIDAD JURIDICA DEL ACREDITADO"

MyWorksheet[nRenglon,10] = "GRUPO DE RIESGO"

MyWorksheet[nRenglon,11] = "ACTIVIDAD ECONÓMICA DEL ACREDITADO"

MyWorksheet[nRenglon,12] = "FECHA DE NACIMIENTO / CONSTITUCION DEL ACREDITADO"

MyWorksheet[nRenglon,13] = "RFC DEL ACREDITADO"

MyWorksheet[nRenglon,14] = "CURP DEL ACREDITADO"

MyWorksheet[nRenglon,15] = "EDAD DEL ACREDITADO"

nRenglon++

MyWorksheet[nRenglon,03] = sC03_Reporte

MyWorksheet[nRenglon,04] = nC04_NoSocio

MyWorksheet[nRenglon,05] = nC05_TipoSocio

MyWorksheet[nRenglon,06] = sC06_NombreSocio

MyWorksheet[nRenglon,07] = sC07_PaternoSocio

MyWorksheet[nRenglon,08] = sC08_MaternoSocio

MyWorksheet[nRenglon,09] = nC09_Personalidad

MyWorksheet[nRenglon,10] = sC10_GrupoRiesgo

MyWorksheet[nRenglon,11] = sC11_Actividad

MyWorksheet[nRenglon,12] = sC12_FNacimiento

MyWorksheet[nRenglon,13] = sC13_RFC

MyWorksheet[nRenglon,14] = sC14_CURP

MyWorksheet[nRenglon,15] = nC15_EdadSocio

fSaveText (sNombreArchivoCSV, sFileContent)

xlsSave(MyWorksheet, sNombreArchivoXLS)

Info("Proceso concluido", sNombreArchivoCSV,sNombreArchivoXLS )

Operaciones sobre tablas

//Agregar un registro

nRenglon = TableCount(TABLE_Detalle)

nRenglon++

TableAdd(TABLE_Detalle)

TABLE_Detalle[nRenglon].COL_IdDB_Articulo = DB_Articulo.IdDB_Articulo

TABLE_Detalle[nRenglon].COL_CodBarras = DB_Articulo.CodigoBarra

TABLE_Detalle[nRenglon].COL_Descripcion = DB_Articulo.Descripcion

TABLE_Detalle[nRenglon].COL_Caducidad = EDT_Caducidad

TABLE_Detalle[nRenglon].COL_Lote = EDT_Lote

TABLE_Detalle[nRenglon].COL_PrecMaxPub = EDT_PrecioMaxPublico

TABLE_Detalle[nRenglon].COL_Cantidad = EDT_Cantidad

TABLE_Detalle[nRenglon].COL_ValorUnitario = EDT_ValorUnitario

TABLE_Detalle[nRenglon].COL_Importe = EDT_Importe

TABLE_Detalle[nRenglon].COL_Descuento = EDT_Descuento

TABLE_Detalle[nRenglon].COL_IVAMonto = EDT_IVA

TABLE_Detalle[nRenglon].COL_IVATasa = EDT_IVATasa

TABLE_Detalle[nRenglon].COL_IEPSMonto = EDT_IEPS

TABLE_Detalle[nRenglon].COL_IEPSTasa = EDT_IEPSTasa

TABLE_Detalle[nRenglon].COL_Total = EDT_Total

//Modificar una cantidad 

IF TableSelect(TABLE_Articulos) = -1 RETURN
nPosicion is int
nTotalRenglones is int
cyCantidad is currency
TableSetFocus(TABLE_Articulos)
// Number of rows found in the "TABLE_Product" control
nTotalRenglones = TableCount(TABLE_Articulos)
// Subscript of selected row in the "TABLE_Product" control
nPosicion     = TableSelect(TABLE_Articulos)
cyCantidad    = Open(WIN_Cantidad)
IF cyCantidad > 0 THEN
    TableSelectPlus(TABLE_Articulos, nPosicion)
    //TableDeleteSelect(TABLE_Articulos)
    TABLE_Articulos.COL_Cantidad = cyCantidad
    TABLE_Articulos.COL_Total = cyCantidad * TABLE_Articulos.COL_PU
    LP_Actualiza()
END

//Borrar

IF TableSelect(TABLE_Articulos) = -1 RETURN
nPosicion is int
nTotalRenglones is int
TableSetFocus(TABLE_Articulos)
// Number of rows found in the "TABLE_Product" control
nTotalRenglones = TableCount(TABLE_Articulos)
// Subscript of selected row in the "TABLE_Product" control
nPosicion = TableSelect(TABLE_Articulos)
TableSelectPlus(TABLE_Articulos, nPosicion)
TableDeleteSelect(TABLE_Articulos)
LP_Actualiza()

////moverse hacia abajo
IF TableSelect(TABLE_Articulos) = -1 RETURN
nPosicion is int
nTotalRenglones is int
TableSetFocus(TABLE_Articulos)
// Number of rows found in the "TABLE_Product" control
nTotalRenglones = TableCount(TABLE_Articulos)
// Subscript of selected row in the "TABLE_Product" control
nPosicion = TableSelect(TABLE_Articulos)
IF nPosicion < nTotalRenglones THEN nPosicion++
TableSelectPlus(TABLE_Articulos, nPosicion)

//Moverse hacia arriba

IF TableSelect(TABLE_Articulos) = -1 RETURN
nPosicion is int
nTotalRenglones is int
TableSetFocus(TABLE_Articulos)
// Number of rows found in the "TABLE_Product" control
nTotalRenglones = TableCount(TABLE_Articulos)
// Subscript of selected row in the "TABLE_Product" control
nPosicion = TableSelect(TABLE_Articulos)
IF nPosicion > 1 THEN nPosicion--
TableSelectPlus(TABLE_Articulos, nPosicion)

Imprimir código de barras

 IF iConfigure(COMBO_ListaImpresoras..DisplayedValue) = True THEN
//IF iConfigure("GTP801 Printer") = True THEN
Info("Entré a imprimir")
iCreateFont(1,8,iBold+iItalic,iRoman)
iCreateFont(2,8,iBold,iRoman)
iCreateFont(3,7,iBold,iRoman)
FOR i=1 TO 2// numero de copias a imprimir
//iPreview(i100)
//IFHReadSeek(Factura,Factura,nFactura)THEN

// IMPRIMIMOS LA CABECERA DE LA FACTURA
iPrint(iFont(1)+"FACTURA ")
iPrint(iFont(1)+"FECHA: " + DateSys())
iPrintWord(iFont(1)+"CLIENTE:")
iPrint(" ")
iPrint(iFont(1) + "Domicilio")
iPrint(RepeatString("-",90))
iPrint()

//HExecuteQuery(QRY_Factura,hQueryDefault,nFactura)
//HReadFirst(QRY_Factura)
iPrint(iFont(1)+"Cantidad Articulo Descripción Precio Total")

//WHILENOTHOut(QRY_Factura)
iPrintWord(iFont(1)+ "Cantidad" )
iXPos(7)
iPrintWord(iFont(1)+iXPos(iXPos()+20)+ "Articulo")

iPrintWord(iFont(1)+iXPos(iXPos()+13)+"Descripcion")

iPrintWord(iFont(1)+iXPos(iXPos()+45)+ "Precio")

iPrint(iFont(1)+iXPos(iXPos()+25)+ "Total")
//HReadNext(QRY_Factura)
//END

Imprimir en papel continuo o tickets (Salvador Soler)

 i,nTotalItems,x,nPos,y isint
bHayEntrega isboolean=False
arrNombreCampos1 isarray0string
arrNombreCampos2 isarray0string
arrNombreCampos3 isarray0string
arrNombreTitulos isarray0string
z isarray of0strings
l1 isarray of0strings
l2 isarray of0strings
l3 isarray of0strings
rs isData Source
c isstring="Tiquet_lineas."
dHeight isreal
s isstring="PrinterType=%1"
t,m,v,s1 isstring
Separador ischaracter=" "
// Vamos a dividir la impresión del tiquet en 5 bloques bloques
// 1.- Cabecera
// 2.- SubCabecera
// 3.- Cuerpo
// 4.- Sub pie
// 5.- Pie


HReadSeek(Preferencias_Tpv,tiendaTerminal,[gsTienda,gsTerminal],hIdentical)
IFPreferencias_Tpv.hayCajonTHEN
IFPreferencias_Tpv.abrir_antesTHEN
s1=ESC+Preferencias_Tpv.esc_abrir
iEscape(s1)
END
END
ListDeleteAll(LIST_Cabecera)
HReadFirst(cabecera,terminalorden)
WHILENOTHOut(cabecera)
ListAdd(LIST_Cabecera,Lower(cabecera.Campo))
HReadNext(cabecera,terminalorden)
END


IFPreferencias_Tpv.impresoraTHEN
// Configuramos la impresora seleccionada
selecionaImpresora()
//
// Buscamos los campos relacionados con el tiquet y los del propio tiquet
//
HReadSeek(Tiquet_cabecera,Tiquet,ti,hIdentical)
s="SELECT MAX(Posicion) AS nPosi FROM Cabecera WHERE tienda='"+gsTienda+"' AND terminal='"+gsTerminal+"'"
HExecuteSQLQuery(rs,hQueryDefault,s)
HReadFirst(rs)
nPos=rs.nposi
HReadSeek(Operaciones,Codigo,Tiquet_cabecera.Operacion,hIdentical)
HReadSeek(Clientes,ClientesID,Tiquet_cabecera.Cliente,hIdentical)
HReadSeek(Usuarios,codigo,Tiquet_cabecera.Operario,hIdentical)
HReadSeek(Departamentos,codigo,Tiquet_cabecera.Departamento,hIdentical)
HReadSeek(Preferencias_Tpv,tiendaTerminal,[gsTienda,gsTerminal],hIdentical)


//
// Creamos las distintas fuentes
//
IFgbVistaPreviaTHENiPreview(i100)
x=Preferencias_Tpv.bold_C?iBoldELSE0
i=Preferencias_Tpv.italic_c?iItalicELSE0
x=x+i
iCreateFont(1,Preferencias_Tpv.size_c,x,Preferencias_Tpv.fuente_C)
x=Preferencias_Tpv.bold_b?iBoldELSE0
i=Preferencias_Tpv.italic_b?iItalicELSE0
x=x+i
iCreateFont(2,Preferencias_Tpv.size_b,x,Preferencias_Tpv.fuente_B)
x=Preferencias_Tpv.bold_p?iBoldELSE0
i=Preferencias_Tpv.italic_p?iItalicELSE0
x=x+i
iCreateFont(3,Preferencias_Tpv.size_p,x,Preferencias_Tpv.fuente_P)
iCreateFont(4,8,0,"Arial")
/////////////////////////////////////////////////////////////////
// Imprimimos la cabecera
////////////////////////////////////////////////////////////////
// El primer dato es un campo RTF
dHeight=iZoneHeight(Preferencias_Tpv.Cab1,300,iRTF)
iPrintZoneRTF(Preferencias_Tpv.Cab1,0,0,300,dHeight)
iYPos(dHeight)// Indica donde empieza la impresión del segundo campo de la cabecera
// Imprimimos el resto de la cabecera
IFNoSpace(Preferencias_Tpv.Cab2)<>""THENiPrint(iFont(1)+Preferencias_Tpv.Cab2)
IFNoSpace(Preferencias_Tpv.cab3)<>""THENiPrint(iFont(1)+Preferencias_Tpv.cab3)
IFNoSpace(Preferencias_Tpv.cab4)<>""THENiPrint(iFont(1)+Preferencias_Tpv.cab4)
IFNoSpace(Preferencias_Tpv.cab5)<>""THENiPrint(iFont(1)+Preferencias_Tpv.cab5)
IFNoSpace(Preferencias_Tpv.cab6)<>""THENiPrint(iFont(1)+Preferencias_Tpv.cab6)
//iPrint(ifont(1))
////////////////////////////////////////////////////////////////
// Imprimimos la sub cabeza
///////////////////////////////////////////////////////////////
s="SELECT * FROM varios WHERE ver=1 AND CabeceraPie=0 AND terminal='"+gsTerminal+"'ORDER BY orden"
HExecuteSQLQuery(rs,hQueryDefault,s)
HReadFirst(rs)
WHILENOTHOut(rs)
SWITCHrs.quehago
CASE0// recibe un campo de una base de datos
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(1)+rs.contenido)
iPrintWord(iFont(1)+Formatea(rs.campo,nPos))
IFrs.print_extraTHENiPrint()
CASE1// Recibe una fecha
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(1)+rs.contenido)
iPrintWord(iFont(1)+DateToString({rs.campo,indItem},"DD/MM/YYYY"))
IFrs.print_extraTHENiPrint()
CASE2// Recibe una Hora
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(1)+rs.contenido)
iPrintWord(iFont(1)+TimeToString({rs.campo,indItem},"HH:MM:SS"))
IFrs.print_extraTHENiPrint()
CASE3// Recibe un cambo de base de datos booleano
// Convierte el contenido en texto
s={rs.campo,indItem}=0?"Sí"ELSE"No"
IFs="Sí"THEN
bHayEntrega=True
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(1)+rs.contenido)
iPrintWord(iFont(1)+s)
END
IFrs.print_extraTHENiPrint()
CASE4// Recibe una variable del sistema
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(1)+rs.contenido)
iPrintWord(iFont(1)+{rs.campo,indVariable})
IFrs.print_extraTHENiPrint()
CASE5// Recibe un carácter que se tiene que repetir n veces.
m=RepeatString(NoSpace(Left(rs.contenido,1)),Preferencias_Tpv.AnchoCabecera)
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(1)+m)
IFrs.print_extraTHENiPrint()
CASE6// DEsglse del cobro
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrint(iFont(1)+rs.contenido)
iXPos(rs.posicion+10)
IFTiquet_cabecera.efectivo<>0THENiPrint(iFont(1)+"Efectivo...:"+Formatea(NumToString(Tiquet_cabecera.efectivo),nPos,False))
iXPos(rs.posicion+10)
IFTiquet_cabecera.Tarjeta<>0THENiPrint(iFont(1)+"Tarjeta....::"+Formatea(NumToString(Tiquet_cabecera.Tarjeta),nPos,False))
iXPos(rs.posicion+10)
IFTiquet_cabecera.Vale_recibido<>0THENiPrint(iFont(1)+"Vale.........:"+Formatea(NumToString(Tiquet_cabecera.Vale_recibido),nPos,False))

IFrs.print_extraTHENiPrint()
CASE7// Impuesto
IFPreferencias_Tpv.pvpconiva=FalseTHEN
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+Preferencias_Tpv.impuesto+"% de "+rs.contenido)
iXPos(nPos)
iPrintWord(iFont(2)+Formatea(rs.campo,nPos))
IFrs.print_extraTHENiPrint()
END
CASE8// Entrega a cuenta
IFbHayEntregaTHEN
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+rs.contenido)
iXPos(iTextWidth(rs.contenido)+1)
iPrint(iFont(2)+Formatea(rs.campo,nPos))
iXPos(rs.posicion)
iPrintWord(iFont(2)+"Pendiente:")
iXPos(iTextWidth(rs.contenido)+1)
iPrint(iFont(2)+Formatea(NumToString(Tiquet_cabecera.pendiente),nPos,False))
IFrs.print_extraTHENiPrint()
END
CASE9// desglose de iva
OTHERCASE
//iprint()
END
HReadNext(rs)
END
iPrint()
iPrint()
//////////////////////////////////////////////////////////////////////////
// Imprimimos el cuerpo
//////////////////////////////////////////////////////////////////////////
// Primero la cabecera del cuerpo
s=RepeatString(Preferencias_Tpv.caracterCabecera,Preferencias_Tpv.AnchoCabecera)
iPrint(iFont(2)+s)
i=1
// Titulo del cuerpo
FOR EACH ROW OFLIST_Cabecera
IFHReadSeek(cabecera,terminalcampo,[gsTerminal,LIST_Cabecera],hIdentical)THEN

//if cabecera.Linea=1 then
ArrayAdd(arrNombreTitulos,cabecera.Campo)
IFcabecera.justificadoTHEN
ArrayAdd(z,Complete(cabecera.titulo,cabecera.tamano,Separador))
ELSE
t=NoSpace(cabecera.titulo)
i=cabecera.tamano-Length(t)
IFi>0THEN
t=RepeatString(Separador,i)+t
END
ArrayAdd(z,t)
END
//HReadFirst(Tiquet_lineas,id)
END
END
i=1
FOR EACH t OF z
m=arrNombreTitulos[i]
HReadSeek(cabecera,terminalcampo,[gsTerminal,m],hIdentical)
iXPos(cabecera.Posicion)
iPrintWord(iFont(2)+t)
i++
END
iPrint()
iPrint(iFont(2)+s)
// Ahora imprimimos las distintas lineas del tiquet
// cada Item puede tener hasta e lineas de texto
// Primera linea de del tiquet, correspondiente al ítem número 1
HReadSeekFirst(Tiquet_lineas,Tiquet,ti)
IFgbDemoTHENiPrint(iFont(2)+"**PROGRAMA DEMOSTRACIÓN**")
WHILEHFound(Tiquet_lineas)
nTotalItems+=Tiquet_lineas.Cantidad
Ajustes_cabecera(LIST_Cabecera,arrNombreTitulos,z,Separador,t,i,c,x,m,l1,arrNombreCampos1,l2,arrNombreCampos2,l3,arrNombreCampos3,v,nPos)
i=1
FOR EACH t OF l1
m=arrNombreCampos1[i]
HReadSeek(cabecera,terminalcampo,[gsTerminal,m],hIdentical)
iXPos(cabecera.Posicion)
iPrintWord(iFont(2)+t)
i++
END
IFi>1THENiPrint()
// Segunda linea de del tiquet, correspondiente al ítem número 1
i=1
FOR EACH t OF l2
m=arrNombreCampos2[i]
HReadSeek(cabecera,terminalcampo,[gsTerminal,m],hIdentical)
iXPos(cabecera.Posicion)
iPrintWord(iFont(2)+t)
i++
END
IFi>1THENiPrint()
// Tercera linea de del tiquet, correspondiente al ítem número 1
i=1
FOR EACH t OF l3
m=arrNombreCampos3[i]
HReadSeek(cabecera,terminalcampo,[gsTerminal,m],hIdentical)
iXPos(cabecera.Posicion)
iPrintWord(iFont(2)+t)
i++
END
IFi>1THENiPrint()
HReadNext(Tiquet_lineas,Tiquet)
END


////////////////////////////////////////////////////////
// Imprimimos el sub pie
////////////////////////////////////////////////////////
s="SELECT * FROM varios WHERE ver=1 and CabeceraPie=1 AND terminal='"+gsTerminal+"' ORDER BY orden"

HExecuteSQLQuery(rs,hQueryDefault,s)
HReadFirst(rs)
WHILENOTHOut(rs)
SWITCHrs.quehago
CASE0// recibe un campo de una base de datos
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+rs.contenido)
IF{rs.campo,indItem}..Type=7THEN
iXPos(nPos)
END
iPrintWord(iFont(2)+Formatea(rs.campo,nPos))
IFrs.print_extraTHENiPrint()
CASE1// Recibe una fecha
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+rs.contenido)
iPrintWord(iFont(2)+DateToString({rs.campo,indItem},"DD/MM/YYYY"))
IFrs.print_extraTHENiPrint()
CASE2// Recibe una Hora
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+rs.contenido)
iPrintWord(iFont(2)+TimeToString({rs.campo,indItem},"HH:MM:SS"))
IFrs.print_extraTHENiPrint()
CASE3// Recibe un cambo de base de datos booleano
// Convierte el contenido en texto
iXPos(rs.posicion)
s={rs.campo,indItem}=0?"Sí"ELSE"No"
IFs="Sí"THEN
bHayEntrega=True
IFNOT rs.combinarTHENiPrint()
iPrintWord(iFont(2)+rs.contenido)
iPrintWord(iFont(2)+s)
END
IFrs.print_extraTHENiPrint()
CASE4// Recibe una variable del sistema
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+rs.contenido)
iPrintWord(iFont(2)+{rs.campo,indVariable})
IFrs.print_extraTHENiPrint()
CASE5// Recibe un carácter que se tiene que repetir n veces.
m=RepeatString(NoSpace(Left(rs.contenido,1)),Preferencias_Tpv.AnchoCabecera)
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+m)
IFrs.print_extraTHENiPrint()
CASE6// DEsglose del cobro
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrint(iFont(2)+rs.contenido)
iXPos(rs.posicion+10)
IFTiquet_cabecera.efectivo<>0THENiPrint(iFont(2)+"Efectivo...:"+Formatea(NumToString(Tiquet_cabecera.efectivo),nPos,False))
iXPos(rs.posicion+10)
IFTiquet_cabecera.Tarjeta<>0THEN
iPrintWord(iFont(2)+"Tarjeta....::"+Formatea(NumToString(Tiquet_cabecera.Tarjeta),nPos,False))
iPrint(iFont(2)+" / "+Tiquet_cabecera.digitosTrajeta)
END
iXPos(rs.posicion+10)
IFTiquet_cabecera.Vale_recibido<>0THENiPrint(iFont(2) +"Vale.........:"+Formatea(NumToString(Tiquet_cabecera.Vale_recibido),nPos,False))
IFrs.print_extraTHENiPrint()
CASE7// Impuesto
IFPreferencias_Tpv.pvpconiva=FalseTHEN
IFTiquet_cabecera.ImporteIva<>0THEN
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
IFTiquet_cabecera.impuesto=0THEN
//
iPrintWord(iFont(2)+rs.contenido)
ELSE
iPrintWord(iFont(2)+Preferencias_Tpv.impuesto+"% de "+rs.contenido)
END
iXPos(nPos)
iPrintWord(iFont(2)+Formatea(rs.campo,nPos))
IFrs.print_extraTHENiPrint()
END
END
CASE8// Entrega a cuenta
IFbHayEntregaTHEN
IFNOT rs.combinarTHENiPrint()
iXPos(rs.posicion)
iPrintWord(iFont(2)+rs.contenido)
iXPos(nPos)
//ixpos(iTextWidth(rs.contenido )+1)
iPrint(iFont(2)+Formatea(rs.campo,nPos))
iXPos(rs.posicion)
iPrintWord(iFont(2)+"Pendiente:")
iXPos(nPos)
//iXPos(iTextWidth(rs.contenido )+1)
iPrint(iFont(2)+Formatea(NumToString(Tiquet_cabecera.pendiente),nPos,False))
IFrs.print_extraTHENiPrint()
END
CASE9// desglose iva
IFgbUsarIvaArticuloTHEN
iPrint(iFont(2))
iPrint(iFont(2)+"Detalle desglose tipo impuesto:")
IFNOT rs.combinarTHENiPrint()
IFTiquet_cabecera.iva_1=0THEN
iXPos(rs.posicion)
iPrintWord(iFont(4)+"Importe exento ")
iXPos(nPos-18)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.Base_1",nPos))
IFrs.print_extraTHENiPrint()
IFNOT rs.combinarTHENiPrint()
IFTiquet_cabecera.iva_2<>0THEN
iXPos(rs.posicion)
iPrintWord(iFont(4)+Tiquet_cabecera.iva_2+" % de Imp. sobre ")
iXPos(nPos-18)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.Base_2",nPos))
iXPos(nPos)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.importe_iva2",nPos))
iPrint(iFont(2))
END
IFTiquet_cabecera.iva_3<>0THEN
iXPos(rs.posicion)
iPrintWord(iFont(4)+Tiquet_cabecera.iva_3+" % de Imp. sobre ")
iXPos(nPos-18)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.Base_3",nPos))
iXPos(nPos)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.importe_iva3",nPos))
iPrint(iFont(2))
END
ELSE
iXPos(rs.posicion)
iPrintWord(iFont(4)+Tiquet_cabecera.iva_1+" % de iImp. sobre ")
iXPos(nPos-18)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.Base_1",nPos))
iXPos(nPos)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.importe_iva1",nPos))
iPrint(iFont(2))
IFTiquet_cabecera.iva_2<>0THEN
iXPos(rs.posicion)
iPrintWord(iFont(4)+Tiquet_cabecera.iva_2+" % de Imp. sobre ")
iXPos(nPos-18)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.Base_2",nPos))
iXPos(nPos)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.importe_iva2",nPos))
iPrint()
END
IFTiquet_cabecera.iva_3<>0THEN
iXPos(rs.posicion)
iPrintWord(iFont(4)+Tiquet_cabecera.iva_3+" % de Imp. sobre ")
iXPos(nPos-18)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.Base_3",nPos))
iXPos(nPos)
iPrintWord(iFont(4)+Formatea("Tiquet_cabecera.importe_iva3",nPos))
iPrint()
END
END
END
END
HReadNext(rs)
END
iPrint()
iPrint()
// Imprimimos el pie
////////////////////////////////////////////////////////
IFNoSpace(Preferencias_Tpv.Pie_1)<>""THENiPrint(iFont(3)+Preferencias_Tpv.Pie_1)
IFNoSpace(Preferencias_Tpv.Pie_2)<>""THENiPrint(iFont(3)+Preferencias_Tpv.Pie_2)
IFNoSpace(Preferencias_Tpv.Pie_3)<>""THENiPrint(iFont(3)+Preferencias_Tpv.Pie_3)
IFNoSpace(Preferencias_Tpv.Pie_4)<>""THENiPrint(iFont(3)+Preferencias_Tpv.Pie_4)
IFNoSpace(Preferencias_Tpv.pie_5)<>""THENiPrint(iFont(3)+Preferencias_Tpv.pie_5)
IFNoSpace(Preferencias_Tpv.pie_6)<>""THENiPrint(iFont(3)+Preferencias_Tpv.pie_6)
x=Preferencias_Tpv.lineas
FOR i=1TO x
iPrint(iFont(2))
END
iPrint(iFont(2)+"Vender y punto")
s1=ESC+Preferencias_Tpv.esc_corte
iEscape(s1)
END
IFPreferencias_Tpv.hayCajonTHEN
IFPreferencias_Tpv.abrir_antes=FalseTHEN
s1=ESC+Preferencias_Tpv.esc_abrir
iEscape(s1)
END
END
IFPreferencias_Tpv.impresoraTHEN
iEndPrinting
END

Leer báscula

 PortNum is int

PortNum = sOpen("COM5", 200, 200, 1) // Open COM1

IF PortNum <> 0 THEN

//sParameter(PortNum, 9600, 1, 8, 0)   //// Configure COM1: Rate 9600, even parity, 8 data bits, 1 stop bit

cMessage is character = "P"

nNumCarEscritos is int

nNumCarEscritos = sWrite(PortNum, cMessage) // Send a message to the output buffer of COM2

// Wait for the end of the write operation

LOOP

IF sInExitQueue(PortNum) = 0 THEN BREAK

END

Number is int

MessageRead is string

MessageRead = sRead(PortNum, 200)

Info("End of write operation", "caracteres escritos: " + nNumCarEscritos, "caracteres salida: " + Number , MessageRead)

sClose(PortNum) // Close COM1 // End of process

ELSE

Error("Error while opening COM5")

END

Configurar la BD HFSQL a usar en Windev

 IF InTestMode() = True THEN
MiConTest is Connection      //conexión de pruebas
MiConTest..User = "ADMIN"
MiConTest..Password = ""
MiConTest..Server = "SERVER01"
MiConTest..Database = "UCTest"
MiConTest..Provider = hAccessHFClientServer
MiConTest..CryptMethod        = hCryptRC5_16
MiConTest..Access = hOReadWrite
MiConTest..ExtendedInfo = "Extended information"
MiConTest..CursorOptions = hClientCursor
MiConTest..Caption                 = "AMBIENTE DE PRUEBAS"
IF HOpenConnection(MiConTest) = True THEN   // Open the connection
IF HChangeConnection("*", MiConTest) = True THEN // Assign the connection to all data files
gbFinPrograma = False
ELSE
Error(HErrorInfo())  
END
ELSE
Error(HErrorInfo())
END
gsAmbienteTrabajo          = "AMBIENTE DE PRUEBAS"

IF gbFinPrograma = False THEN
IF gpwOpenConnection(MiConTest) = True THEN
gnResultado = gpwOpen()
IF gnResultado <> gpwOk THEN   // If the login failed
SWITCH gnResultado
CASE gpwError:
Error("Error al inicializar el GroupWare.", ErrorInfo())
gbFinPrograma = True
CASE gpwUnknownUser:
Error("Usuario desconocido en GroupWare.")
gbFinPrograma = True
CASE gpwInvalidPassword:
Error("Password Inválido en GroupWare")
gbFinPrograma = True
CASE gpwCancel:
Error("El usuario oprimió Cancelar en GroupWare")
gbFinPrograma = True
OTHER CASE
Error("Error desconocido en GroupWare")
gbFinPrograma = True
END
ELSE
gbFinPrograma = False
END
ELSE
Error(ErrorInfo())
gbFinPrograma = True
END
END

ELSE //********************************************************************************************

MiConUCSoft is Connection   //conexión de produccion
MiConUCSoft..User = "ADMIN"
MiConUCSoft..Password = ""
MiConUCSoft..Server = "SERVER01"
MiConUCSoft..Database = "UCSoft"
MiConUCSoft..Provider = hAccessHFClientServer
MiConUCSoft..CryptMethod      =hCryptRC5_16
MiConUCSoft..Access = hOReadWrite
MiConUCSoft..ExtendedInfo = "Extended information"
MiConUCSoft..CursorOptions = hClientCursor
MiConUCSoft..Caption        = "AMBIENTE DE PRODUCCION"
IF HOpenConnection(MiConUCSoft) = True THEN   // Open the connection
IF HChangeConnection("*", MiConUCSoft) = True THEN // Assign the connection to all data files
gbFinPrograma = False
ELSE
Error(HErrorInfo())  
END
ELSE
Error(HErrorInfo())
END
gsAmbienteTrabajo          = "AMBIENTE DE PRODUCCION"

IF gbFinPrograma = False THEN
IF gpwOpenConnection(MiConUCSoft) = True THEN
gnResultado = gpwOpen()
IF gnResultado <> gpwOk THEN   // If the login failed
SWITCH gnResultado
CASE gpwError:
Error("Error al inicializar el GroupWare.", ErrorInfo())
gbFinPrograma = True
CASE gpwUnknownUser:
Error("Usuario desconocido en GroupWare.")
gbFinPrograma = True
CASE gpwInvalidPassword:
Error("Password Inválido en GroupWare")
gbFinPrograma = True
CASE gpwCancel:
Error("El usuario oprimió Cancelar en GroupWare")
gbFinPrograma = True
OTHER CASE
Error("Error desconocido en GroupWare")
gbFinPrograma = True
END
END
ELSE
Error(ErrorInfo())
gbFinPrograma = True
END
END
END  //**************************************************

IF gbFinPrograma = True THEN EndProgram()