sambomb

Achei o problema:

Estou tentando acessar um webservice que trabalha com encoding="ISO-8859-1"

O problema é que o arquivo de retorno possui caracteres especiais e está gerando divergência nos dados.

Cabeçalho do XML

<?xml version="1.0" encoding="ISO-8859-1" ?>

Trecho obtido do navegador:
<nomeSegmento>Cacau em Pó</nomeSegmento>

<nomeSegmento>Farinha de Linhaça</nomeSegmento>

Ao criar um TXT com o retorno do XML para tratar:
<nomeSegmento>Cacau em P?omeSegmento>
<nomeSegmento>Farinha de Linha?/nomeSegmento>

Notei que todos os caracteres especiais e os 2 subsequentes são substituidos por uma única interrogação, causando o problema citado acima

****************************************************************************
METHOD Comunicar(cTipo, cFiltro) CLASS TAvantFiscal
****************************************************************************
*
* Comunicar no webservice
* Parametros: cTipo, cFiltro
* Retorno: lResult
*
* Autor: Samir
* 06/05/2015 - 14:16:50
*
****************************************************************************

local lResult := .T., cUrl := "", nContador := 0

   Default cTipo := ::cTipoFiltro

   //-- Limpar variável de retorno no inicio para caso gere erro não mantenha o anterior
   ::cRetorno := ""

   //-- Seta maiusculo para o tipo
   cTipo := UT(cTipo)

   //-- Preencher a URL do webservice
   cUrl := ::cUrl
   cUrl += "?idIntegracao=" + ::cIdIntegracao
   cUrl += "&idCliente=" + ::cIdCliente
   cUrl += "&token=" + ::cToken

   //-- Verificar o tipo do filtro
   If cTipo = "D" //-- Data

      Default cFiltro := DtoC(::dFiltro)

      cUrl += "&dtFiltro="+cFiltro

   ElseIf cTipo = "E" //-- Ean - Código de Barras

      Default cFiltro := ::cEAN

      cUrl += "&ean="+cFiltro

   ElseIf cTipo = "N" //-- NCM - Nomenclatura Comum Mercosul

      Default cFiltro := ::cNCM

      cUrl += "&ncm="+cFiltro

   Else

      Msg("Tipo de filtro inválido, verifique.")

      Return .F.

   End

   //-- Instanciar o objeto do Internet Explorer
   Try

      ::oConecta := CreateObject( "MSXML2.XMLHTTP.3.0" )

   Catch

      Try

         ::oConecta := CreateObject( "MSXML2.XMLHTTP" )

      Catch

         Try

            ::oConecta := CreateObject( "Microsoft.XMLHTTP" )

         catch

            Msg("Falha ao criar objeto de conexão."+ CRLF + "Verifique a versão do Internet Explorer e a conexão de internet.","Avant Fiscal")

            Return .F.

         End

      End

   End

   //HB_SetCodePage("PTISO") //-- Não resolveu

   //-- configura os parametros do wsdl
   ::oConecta:open("GET", cUrl, .F.)

   ::oConecta:SetRequestHeader( "Content-Type" , "text/xml; charset=utf-8" )
//   ::oConecta:SetRequestHeader( "Content-Type" , "text/xml; charset=ISO-8859-1" ) //-- Não resolveu

   //-- envia o request
   TRY

      ::oConecta:send()

   CATCH oError

      Msg("Erro ao conectar ao site:;" + ::cUrl + CRLF + "Verifique a versão do Internet Explorer e a conexão de internet.","Avant Fiscal")

      Return .f.

   END

   //-- aguarda alguns segundos a resposta
   While ::oConecta:readyState <> 4

      millisec(50)

      SysRefresh()

      nContador++

      Barra(UT(nContador)+" de 100")

      //-- Teste para não permitir loop infinito
      If nContador > 100

         Msg("Tempo limite de conexão atingido, verifique.","Avant Fiscal")

         Return .F.

      End

   End

   //-- Gravar o retorno na variável
   ::cRetorno := ::oConecta:responsetext

   ::TratarRetorno()

   Msg(::cRetorno,cUrl)

   //HB_SetCodePage("EN") //-- Não precisa, pois a alteração acima não resolveu

return lResult
/*------------------------------------------------------------------------*/

****************************************************************************
METHOD TratarRetorno() CLASS TAvantFiscal
****************************************************************************
*
* Tratar retorno do site
* Parametros:
* Retorno:
*
* Autor: Samir
* 07/05/2015 - 16:39:02
*
****************************************************************************

local cFileRetorno := "", hHandle := 0, oXml

//Bulgarian       Windows-1251   HB_CODEPAGE_BG1251   "BG1251" cpbgwin.c
//Bulgarian       MIK            HB_CODEPAGE_BGMIK    "BGMIK"  cpbgmik.c
//Croatien        1250           HB_CODEPAGE_HR1250   "HR1250" cphr1250.c
//Croatien        437            HB_CODEPAGE_HR437    "HR437"  cphr437.c
//Croatien        852            HB_CODEPAGE_HR852    "HR852"  cphr852.c
//English         437            none                 "EN"     cp_tpl.c
//French          850            HB_CODEPAGE_FR       "FR"     cpfrdos.c
//German          850            HB_CODEPAGE_DE       "DE"     cpgedos.c
//German          ISO-8859-1     HB_CODEPAGE_DEWIN    "DEWIN"  cpgewin.c
//Greek (Dos)     737            HB_CODEPAGE_EL       "EL"     cpeldos.c
//Greek WIN       ANSI (1253)    HB_CODEPAGE_ELWIN    "ELWIN"  cpelwin.c
//Hungarian       852            HB_CODEPAGE_HU852    "HU852"  cphu852.c
//Hungarian       Windows-1250   HB_CODEPAGE_HUWIN    "HUWIN"  cphuwin.c
//Italian         437            HB_CODEPAGE_IT437    "IT437"  cpit437.c
//Italian         850            HB_CODEPAGE_IT850    "IT850"  cpit850.c
//Italian         ISO-8859-1     HB_CODEPAGE_ITISO    "ITISO"  cpitiso.c
//Italian         ISO-8859-1b    HB_CODEPAGE_ITISB    "ITISB"  cpitisb.c (with BOX chars)
//Lithuanian      Windows-1257   HB_CODEPAGE_LT       "LT"     cpltwin.c
//Polish          852            HB_CODEPAGE_PL852    "PL852"  cppl852.c
//Polish          ISO-8859-2     HB_CODEPAGE_PLISO    "PLISO"  cppliso.c
//Polish          Mazovia        HB_CODEPAGE_PLMAZ    "PLMAZ"  cpplmaz.c
//Polish          Windows-1250   HB_CODEPAGE_PLWIN    "PLWIN"  cpplwin.c

//Portuguese      850            HB_CODEPAGE_PT850    "PT850"  cppt850.c
//Portuguese      ISO-8859-1     HB_CODEPAGE_PTISO    "PTISO"  cpptiso.c

//Russian         Windows-1251   HB_CODEPAGE_RU1251   "RU1251" cpruwin.c
//Russian         866            HB_CODEPAGE_RU866    "RU866"  cpru866.c
//Russian         KOI-8          HB_CODEPAGE_RUKOI8   "RUKOI8" cprukoi.c
//Serbian         Windows-1251   HB_CODEPAGE_SRWIN    "SRWIN"  cpsrwin.c
//Slovenian       852            HB_CODEPAGE_SL852    "SL852"  cpsl852.c
//Slovenian       ISO-8859-2     HB_CODEPAGE_SLISO    "SLISO"  cpsliso.c
//Slovenian       Windows-1250   HB_CODEPAGE_SLWIN    "SLWIN"  cpslwin.c
//Spanish         850            HB_CODEPAGE_ES       "ES"     cpesdos.c
//Spanish(Modern) ISO-8859-1     HB_CODEPAGE_ESMWIN   "ESMWIN" cpesmwin.c
//Spanish         ISO-8859-1     HB_CODEPAGE_ESWIN    "ESWIN"  cpeswin.c
//Ukrainian       Windows-1251   HB_CODEPAGE_UA1251   "UA1251" cpuawin.c
//Ukrainian       866            HB_CODEPAGE_UA866    "UA866"  cpua866.c
//Ukrainian       KOI-8U         HB_CODEPAGE_UAKOI8   "UAKOI8" cpuakoi.c

//-- Nenhum desses tratamentos resolveu
//   HB_SetCodePage("PTISO")
//   Debuga HB_LangName()

//   cFileRetorno := DirExe() + "RetornoAF_ISO"+StrTran(Now(),":")+".xml"

//   CreateTxt(cFileRetorno, ::cRetorno )

//   HB_SetCodePage("PT850")
//   Debuga HB_LangName()

//   cFileRetorno := DirExe() + "RetornoAF_850"+StrTran(Now(),":")+".xml"

//   CreateTxt(cFileRetorno, ::cRetorno )

//   cFileRetorno := DirExe() + "RetornoAF_Translate850EN"+StrTran(Now(),":")+".xml"

//   CreateTxt(cFileRetorno, HB_Translate(::cRetorno,"PT850","EN") )

//   cFileRetorno := DirExe() + "RetornoAF_OemtoAnsi"+StrTran(Now(),":")+".xml"

//   CreateTxt(cFileRetorno, OemToAnsi(::cRetorno ) )

//   cFileRetorno := DirExe() + "RetornoAF_AnsitoOem"+StrTran(Now(),":")+".xml"

//   CreateTxt(cFileRetorno, AnsitoOem(::cRetorno ) )

   cFileRetorno := DirExe() + "RetornoAF_"+StrTran(Now(),":")+".xml"

   CreateTxt(cFileRetorno, HB_AnsiToOem(::cRetorno) )

   Msg("Arquivo criado")

   hHandle := FOpen( cFileRetorno )

   IF hHandle == -1

     Msg("Não foi possível abrir o XML!","Avant Fiscal")

   Else

      oXml := TXmlDocument():New( hHandle )

      IF oxml:nStatus != HBXML_STATUS_OK

         Msg("Erro ao processar o arquivo:" + CRLF +;
             "na Linha: " + AllTrim( Str( oxml:nLine ) ) + CRLF +;
             "Erro: " + HB_XmlErrorDesc( oxml:nError ) + CRLF +;
             "Erro na Tag: " + oxml:oErrorNode:cName + CRLF +;
             "Início Tag na linha: " + AllTrim( Str( oxml:oErrorNode:nBeginLine ) ),"Avant Fiscal")

      End

   End

   fClose( hHandle )

   fErase( cFileRetorno )

return
/*------------------------------------------------------------------------*/

Empresoft e Theotokos, ele já me questionou no skype sobre isso e recomendei a mesma coisa mas ele está resistente a ideia pelo visto.

Tente instalar o driver de 32 bits

Segue um exemplo de como eu defino o acesso a um DBF no Fast

****************************************************************************
FUNCTION ImprimeCarne()
****************************************************************************
Local cDir := "", lProssegue := .F.
local bAction
Private oFrPrn
 
   //-- Gerar objeto Fast-Report
   cDir := DirExe()
 
   oFrPrn := frReportManager():new( cDir + "FRSystH.dll" )
 
   //-- Configurar os campos
   With object oFrPrn
 
      :LoadFromResource("CARNENOVO")
      
      GeraDatabaseFR()
      
      :SetProperty("NomeEmp.Memo", "Text", pEmp:cFantasia)
      :SetProperty("EnderecoEmp.Memo", "Text",  pEmp:cEndereco + " - " +;
                                                pEmp:cCidade + " / " +;
                                                pEmp:cEstado)
      
      //-- Configurar o preview
      :PreviewOptions:SetAllowEdit(.F.)
      :PreviewOptions:SetButtons(1209)
      :PreviewOptions:SetMaximized(.T.)
      
      //-- Preview
      :ShowReport()
      
      //-- Limpa os datasets
      :ClearDataSets()
      
      //-- Fecha/Limpa
      :Clear()
      
      //-- Destrói
      :DestroyFR()
 
   end
 
   Select CARNE
   DbCloseArea()
 
RETURN .T.
/*------------------------------------------------------------------------*/
 
****************************************************************************
static Procedure GeraDatabaseFR()
****************************************************************************
*
* Gerar os bancos de dados em aberto no fast report
* Parametros:
* Retorno: Nenhum
*
* Autor: Samir
* 21/6/2009 - 08:52:17
*
****************************************************************************
 
local aDbf := ListaAlias(), x := 0, y := 0, i := 0
 
   aDbf := ListaAlias()
 
   x := 10 ; y := 20
 
   With object oFrPrn
 
      For i = 1 to Len(aDbf)
 
         If !:SetProperty( aDbf[i], "TableName", pDir + aDbf[i] + ".DBF")
            :CreateFRObject("TFrxHarbourWorkArea","Data",aDbf[i], x, 10, y, 20)
         end
 
         //-- Modificar as propiedades do Data Source Estoque
         :SetProperty( aDbf[i], "TableName", pDir + aDbf[i] + ".DBF")
         :SetProperty( aDbf[i], "UserName", aDbf[i])
         :SetProperty( aDbf[i], "Name", aDbf[i])
         :SetProperty( aDbf[i], "Alias", aDbf[i])
         :SetProperty( aDbf[i], "WorkArea", Select(aDbf[i]) )
         
         //-- Adicionar Data Source ao relatório
         :AddGlobalDsToReport(aDbf[i])
         
         x += 50 ; y += 50
         
      end//-- For i = 1 to Len(aDbf)
         
   end//-- With object oFrPrn
 
Return nil
/*------------------------------------------------------------------------*/
 
****************************************************************************
Function ListaAlias()
****************************************************************************
*
* Listar todos os alias em aberto
* Parametros:
* Retorno: aAlias
*
* Autor: Samir
* 21/7/2009 - 16:53:12
*
****************************************************************************
 
local aAlias := {}, i := 0
 
   i:= 1
 
   If Empty( Alias( i ) )
      Return aAlias
   end
 
   While !Empty( Alias( i ) )
 
      aAdd(aAlias,Upper( AllTrim( Alias( i ) ) ) )
 
      i++
 
   end
 
Return aAlias
 
/*------------------------------------------------------------------------*/

Da um DbGoTop() nessa tabela, pode ser issso....

http://forums.fivetechsupport.com/viewforum.php?f=5
http://forums.fivetechsupport.com/viewforum.php?f=8

opa, que legal, funcionou, o duro é ter que ficar colocando isso em tudo qto é lugar que tenha combobox, checkbox....que dureza...porem tá valendo...

Na verdade não precisa, só alterar o On Init do dialog.prg e rodar os objetos da tela verificando se tem um item válido com a dica do Gilmer, mata todos os coelhos com uma cajadada só

Dependendo do desespero pode colocar um groupbox em volta e exibir/esconder no GetFocus/LostFocus dos componentes

Outra solução é você desabilitar o foco nesses componentes, assim evita que ao usar TAB para ir navegando nos componentes eles sejam ignorados...

Só ponto uma opinião a ser analisada que alguns podem não saber...
Ele está mudando para a Coréia do Sul para montar uma empresa lá e acho que isso diz bastante sobre a importância que ele está dando a esse projeto...

It will belong to a new company that it will be created once I arrive at South Korea (Seoul) very soon.

Sua internet usa proxy?
Se tiver pode ser esse o problema, tem configuração específica para quando usa proxy...

NetName()

Retrieves the current user name or the computer name.

Syntax

NetName( [<lInfo>] ) --> cComputerName | cUserName

Arguments

<lInfo>

If <lInfo> is set to .T. (true), the function returns the user account name, otherwise it returns the computer name. Return

The function returns a character string containing either the computer name or the user name. If this information cannot be retrieved, an empty string ("") is returned.

Description

NetName() serves informational purposes and is used when different users log into the same computer, or when multiple computers run the same application in a network.

Info

See also: Os(), Version()

Category: Environment functions , Network functions

Source: rtl\net.c

LIB: xhb.lib

DLL: xhbdll.dll

/***************************************************************************
* Programa ....: DateTime.PRG
* Autor .......: Samir
* Date ........: 2/3/2010 às 10:30:13
* Revisado em .: 2/3/2010 às 10:30:13
*
* Classe para tratar uma Date e Time em conjunto
*
***************************************************************************/

#include 'FiveWin.ch'

CLASS TDateTime

   //-- Propriedades -----------------------------------------------------//

   //-- Atributos a serem acessados
   DATA Date                AS Date       INIT Date()       READONLY
   DATA Time                AS Character  INIT Time()       READONLY
   DATA Secs                AS Numeric    Init 0            READONLY

   //-- Uso interno da classe
   DATA nSecsMinute         AS Numeric    Init 0            HIDDEN
   DATA nSecsHour           AS Numeric    Init 0            HIDDEN
   DATA nSecsDay            AS Numeric    Init 0            HIDDEN
   DATA nSecsMonth          AS Numeric    Init 0            HIDDEN
   DATA nSecsYear           AS Numeric    Init 0            HIDDEN

   //-- Métodos ----------------------------------------------------------//

   //-- Construção
   METHOD New(cDateIni,cTimeIni)                            CONSTRUCTOR
   METHOD End()


   METHOD Absolute(dDateReference)

   //-- Uso Interno
   METHOD Verify()                                          HIDDEN
   METHOD UpdateVar()                                       HIDDEN

   //-- Modificar atributos da classe
   METHOD SetDate(dDate) INLINE ( ::Date := dDate )
   METHOD SetTime(cTime) INLINE ( ::Time := cTime, ::Secs := Secs(cTime) )

   //-- Add Time
   METHOD AddHour(nTime)                                    //PUBLIC
   METHOD AddMinute(nMinute)                                //PUBLIC
   METHOD AddSecond(nSecond)                                //PUBLIC

   //-- Add Date
   METHOD AddDay(nDay)                                      //PUBLIC
   METHOD AddMonth(nMonth)                                  //PUBLIC
   METHOD AddYear(nYear)                                    //PUBLIC

   //-- Remove Tempo
   METHOD RemHour(nTime)                                    //PUBLIC
   METHOD RemMinute(nMinute)                                //PUBLIC
   METHOD RemSecond(nSecond)                                //PUBLIC

   //-- Remove Date
   METHOD RemDay(nDay)                                      //PUBLIC
   METHOD RemMonth(nMonth)                                  //PUBLIC
   METHOD RemYear(nYear)                                    //PUBLIC

   //-- Compatibilidade ( Aceitar comandos no plural ) -------------------//

   //-- Add Tempo
   METHOD AddHours(nHour)        INLINE   ::AddHour(nHour)
   METHOD AddMinutes(nMinute)    INLINE   ::AddMinute(nMinute)
   METHOD AddSeconds(nSecond)    INLINE   ::AddSecond(nSecond)

   //-- Add Date
   METHOD AddDays(nDay)          INLINE   ::AddDays(nDay)
   METHOD AddMonths(nMonth)      INLINE   ::AddMonth(nMonth)
   METHOD AddYears(nYear)        INLINE   ::AddYear(nYear)

   //-- Remove Tempo
   METHOD RemHour(nHour)         INLINE   ::RemHour(nHour)
   METHOD RemMinutes(nMinute)    INLINE   ::RemMinute(nMinute)
   METHOD RemSeconds(nSecond)    INLINE   ::RemSecond(nSecond)

   //-- Remove Date
   METHOD RemDays(nDay)          INLINE   ::RemDay(nDay)
   METHOD RemMonths(nMonth)      INLINE   ::RemMonth(nMonth)
   METHOD RemYears(nYear)        INLINE   ::RemYear(nYear)

ENDCLASS

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD New(xDateIni,cTimeIni) CLASS TDateTime
****************************************************************************
*
* Initiate the object
* Parametros: Nenhum
* Retorno: Self (Object)
*
* Autor .......: Samir
* Date ........: 2/3/2010 às 10:30:20
*
****************************************************************************

   Default xDateIni := Date(), cTimeIni := Time()
   
   If ValType(xDateIni) = "C"
      ::Date := cTod(xDateIni)
   elseif ValType(xDateIni) = "D"
      ::Date := xDateIni
   else
      ::Date := Date()
   end
   
   ::Time := cTimeIni
   
   ::Secs := Secs(cTimeIni)

   ::nSecsMinute := 60                  //-- FIXO
   ::nSecsHour   := ::nSecsMinute * 60  //-- FIXO
   ::nSecsDay    := ::nSecsHour   * 24  //-- FIXO

   //-- Atualizar Seconds do Month/Year
   ::UpdateVar()

return Self

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD End() CLASS TDateTime
****************************************************************************
*
* Release the object from memory
* Parametros: Nenhum
* Retorno: Nil
*
* Autor .......: Samir
* Date ........: 2/3/2010 às 10:30:20
*
****************************************************************************

   Self := Nil

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD UpdateVar() CLASS TDateTime
****************************************************************************
*
* Update the second counting vars
* Parametros:
* Retorno: Nil
*
* Autor: Samir
* 2/3/2010 - 13:52:18
*
****************************************************************************

   ::nSecsMonth   := ::nSecsDay    * LastDay(::Date)
   ::nSecsYear    := ::nSecsDay    * If ( IsBissexto(::Date), 366, 365 )

return nil
/*------------------------------------------------------------------------*/

****************************************************************************
METHOD Verify() CLASS TDateTime
****************************************************************************
*
* Verify if happen and Date update based on the Seconds
* Parametros: Nenhum
* Retorno: Nil
*
* Autor .......: Samir
* Date ........: 2/3/2010 às 10:30:20
*
****************************************************************************

Local lRewind := .F.

   //-- Verify if is negative or positive
   If ::Secs < 0
   
      lRewind := .T.
      
      ::Secs := Abs(::Secs)
      
   end

   //-- Increase
   If !lRewind

      //-- Verify if increase one Day
      While ::Secs > ::nSecsDay

         ::Secs -= ::nSecsDay
         ::AddDay()

      end

      //-- Update time with the rest
      ::Time := TString(::Secs)

   //-- Decrease
   else

      //-- Verify if decrease one Day
      While ::Secs > ::nSecsDay

         ::Secs -= ::nSecsDay
         ::RemDay()

      end

      //-- If time is negative, make reference to the last day
      ::RemDay()

      //-- Update time with the rest
      ::Time := TString(::nSecsDay - ::Secs)

   end
   
   ::UpdateVar()

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD AddHour(nHour) CLASS TDateTime
****************************************************************************
*
* Add Hour
* Parametros: nHour
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:33:57
*
****************************************************************************

   Default nHour := 1
   
   ::Secs += nHour * ::nSecsHour
   
   ::Verify()

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD AddMinute(nMinute) CLASS TDateTime
****************************************************************************
*
* Add Minute
* Parametros: nMinute
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:30
*
****************************************************************************

   Default nMinute := 1
   
   ::Secs += nMinute * ::nSecsMinute

   ::Verify()

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD AddSecond(nSecond) CLASS TDateTime
****************************************************************************
*
* Add Second
* Parametros: nSecond
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:58
*
****************************************************************************

local Result := nil

   Default nSecond := 1

   ::Secs += nSecond

   ::Verify()

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD AddDay(nDay) CLASS TDateTime
****************************************************************************
*
* Add Day
* Parametros: nDay
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:37:46
*
****************************************************************************

local Result := nil, nMax := 0, nEndMonth := 0, nAux := 0, cAux := ""

   Default nDay := 1

   ::Date := ::Date + nDay

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD AddMonth(nMonth) CLASS TDateTime
****************************************************************************
*
* Add Month
* Parametros: nMonth
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:30
*
****************************************************************************

local Result := nil

   Default nMonth := 1

   ::Date := IncMonth(::Date,nMonth)

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD AddYear(nYear) CLASS TDateTime
****************************************************************************
*
* Add Year
* Parametros: nYear
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:58
*
****************************************************************************


local Result := nil, nDayAux := 0, nMonthAux := 0, nYearAux := 0, cDateAux := ""

   Default nYear := 1

   nDayAux      := Day(  ::Date())
   nMonthAux    := Month(::Date())
   nYearAux     := Year( ::Date())

   nYearAux += nYear

   cDateAux += StrZero(nDayAux,2)   + "/"
   cDateAux += StrZero(nMonthAux,2) + "/"
   cDateAux += StrZero(nYearAux,4)

   ::Date := CtoD(cDateAux)

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD RemHour(nHour) CLASS TDateTime
****************************************************************************
*
* Add Hour
* Parametros: nHour
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:33:57
*
****************************************************************************

local Result := nil

   Default nHour := 1
   
   ::Secs -= nHour * ::nSecsHour

   ::Verify()

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD RemMinute(nMinute) CLASS TDateTime
****************************************************************************
*
* Add Minute
* Parametros: nMinute
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:30
*
****************************************************************************

local Result := nil

   Default nMinute := 1
   
   ::Secs -= nMinute * ::nSecsMinute

   ::Verify()
   
return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD RemSecond(nSecond) CLASS TDateTime
****************************************************************************
*
* Add Second
* Parametros: nSecond
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:58
*
****************************************************************************

local Result := nil

   Default nSecond := 1

   ::Secs -= nSecond
   
   ::Verify()

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD RemDay(nDay) CLASS TDateTime
****************************************************************************
*
* Add Day
* Parametros: nDay
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:37:46
*
****************************************************************************

local nMax := 0

   Default nDay := 1
   
   ::Date := ::Date - nDay
   
return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD RemMonth(nMonth) CLASS TDateTime
****************************************************************************
*
* Add Month
* Parametros: nMonth
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:30
*
****************************************************************************

   Default nMonth := 1
   
   ::Date := DecMonth(::Date,nMonth)

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD RemYear(nYear) CLASS TDateTime
****************************************************************************
*
* Add Year
* Parametros: nYear
* Retorno: NIL
*
* Autor: Samir
* 2/3/2010 - 10:34:58
*
****************************************************************************

local nDayAux := 0, nMonthAux := 0, nYearAux := 0, cDateAux := ""

   Default nYear := 1
   
   nDayAux      := Day(::Date())
   nMonthAux    := Month(::Date())
   nYearAux     := Year(::Date())
   
   nYearAux -= nYear
   
   cDateAux += StrZero(nDayAux,2)   + "/"
   cDateAux += StrZero(nMonthAux,2) + "/"
   cDateAux += StrZero(nYearAux,4)
   
   ::Date := CtoD(cDateAux)

return nil

/*------------------------------------------------------------------------*/

****************************************************************************
METHOD Absolute(dDateReferencia) CLASS TDateTime
****************************************************************************
*
* Obter um valor absoluto em Seconds da Date mais Time
* Parametros: dDateReferencia
* Retorno: nValorAbsoluto
*
* Autor: Samir
* 17/11/2010 - 10:51:08
*
****************************************************************************

local nValorAbsoluto := 0, nDays := 0

   Default dDateReferencia := cTod("01/01/1920")

   nDays := Abs( ::Date - dDateReferencia)

   nValorAbsoluto := nDays * ::nSecsDay

   nValorAbsoluto += ::Secs

return nValorAbsoluto
/*------------------------------------------------------------------------*/

****************************************************************************
static function IsBissexto(xDate)
****************************************************************************
*
* Verificar se um ano é bissexto ou não
* Parametros: xDate
* Retorno: lResult
*
* Autor: Samir
* 2/3/2010 - 11:15:02
*
****************************************************************************

local lResult := .T., nYear := 0

   If ValType(xDate) = "D"
      nYear := Year(xDate)
   elseif ValType(xDate) = "N"
      nYear := xDate
   elseif ValType(xDate) = "C"
      If IsDigit(xDate)
         If Len(xDate) = 2 .or. Len(xDate) = 4
            nYear := Val(xDate)
         else
            lResult := .F.
         end
      else
         lResult := .F.
      end
   else
      lResult := .F.
   end

   If lResult

      If nYear % 4 = 0 .and. nYear % 100 != 0
         lResult := .T.
      Elseif nYear % 100 = 0 .and. nYear % 400 = 0
         lResult := .T.
      Else
         lResult := .F.
      End

   else

      MsgInfo("Invalid Date parameter")
   
   end

Return lResult

/*------------------------------------------------------------------------*/

****************************************************************************
function LastDay( dDateVal )
****************************************************************************
Local nLastDay, nMonthNum, nNumDays

   If dDateVal = NIL
      dDateVal := Date()
   ElseIf Valtype( dDateVal ) == 'N' 
      nMonthNum := dDateVal
   ElseIf Valtype( dDateVal ) == 'D'
      nMonthNum := Month( dDateVal )
   Else
      Return 0
   Endif

   nNumDays  := 31

   Do Case
      Case nMonthNum = 4 .or. nMonthNum = 6 .or. nMonthNum = 9 .or. ;
         nMonthNum = 11
         nNumDays := 30
      Case nMonthNum = 2
         If Year( dDateVal ) % 4 = 0 .and. Year( dDateVal ) % 100 != 0
            nNumDays := 29
         Elseif Year( dDateVal ) % 100 = 0 .and. Year( dDateVal ) % 400 = 0
            nNumDays := 29
         Else
            nNumDays := 28
         Endif
   Endcase

Return( nNumDays )

/*------------------------------------------------------------------------*/

****************************************************************************
function IncMonth(dDate, nMonth)
****************************************************************************

local Result := dDate, nDia := 0, nAno := 0, nMes := 0, cData := ""

   nDia := Day(dDate)
   nMes := Month(dDate)
   nAno := Year(dDate)

   nMes += nMonth
   nMonth := nMes

   if nMes > 12
      if nMes % 12 == 0
         nMes := 12
      else
         nMes := nMes % 12
         nAno += Trunc(nMonth / 12,0)
      end
   end

   if (AllTrim(Str(nMes,2,0)) $ "4,6,9,11") .and. nDia >= 30
      nDia := 30
   elseif (AllTrim(Str(nMes,2,0)) == "2") .and. nDia >= 28
      nDia := 28
   end

   cData := AllTrim(Str(nDia,2,0)) + '/' + AllTrim(Str(nMes,2,0)) + '/' + ;
            AllTrim(Str(nAno,4,0))

   if Empty(CTOD(cData))
      MsgAlert(cData)
   end

   Result := CtoD(cData)

Return Result

/*------------------------------------------------------------------------*/

****************************************************************************
function DecMonth(dDate, nMonth)
****************************************************************************

local Result := dDate, nDia := 0, nAno := 0, nMes := 0, cData := ""

   nDia := Day(dDate)
   nMes := Month(dDate)
   nAno := Year(dDate)

   nAno -= Trunc(nMonth / 12,0)

   nMes -= ( nMonth % 12 )

   if nMes <= 0

      if nMonth % 12 == 0
         //nMes := 12
         nMes := Month(dDate)
      else

         nAno -= 1
         nMes += 12

      end
   end

   if (AllTrim(Str(nMes,2,0)) $ "4,6,9,11") .and. nDia = 31
      nDia := 30
   elseif (AllTrim(Str(nMes,2,0)) == "2") .and. nDia >= 29
      nDia := 28
   end

   cData := AllTrim(Str(nDia,2,0)) + '/' + AllTrim(Str(nMes,2,0)) + '/' + ;
            AllTrim(Str(nAno,4,0))

   Result := CtoD(cData)

Return Result

/*------------------------------------------------------------------------*/
 

Com o método Absolute() você tem o tempo em segundos e pode comparar o tempo de duas instâncias da classe, exemplo:

oDataHoraNFE := TDateTime():New(dDataNFE,cHoraNFE)

oDataHoraAtual := TDateTime():New()

nDiferenca := oDataHoraAtual:Absolute() - oDataHoraNFE:Absolute()

If nDiferenca > ( 24*60*60 ) //24 horas, 60 minutos, 60 segundos

?"Diferença maior que um dia"

End

Pense num cara de sorte!!! kkkkkkkkkkkkkkkkkkkkkkkkkkk

João,

Cuando termine de solucionar lo que le falta a Fivedit con tu ayuda, tendrás un FWH 15.01 de regalo 
regards, saludos

Antonio Linares
www.fivetechsoft.com

http://forums.fivetechsupport.com/viewtopic.php?f=6&t=26913

Abs.

Invejei!

Queria um update mas ta dificil de desembolsar dinheiro...

http://wiki.fivetechsoft.com/doku.php?id=fivewin_function_dragqueryfiles

Com -r agora funcionou!

C:\Compiladores\bcc582\Bin>brc32.exe -r C:\Versoes\Farma\RCAPAF.rc

Borland Resource Compiler Version 5.40

Copyright © 1990, 1999 Inprise Corporation. All rights reserved.

Muito obrigado, agora é só fazer a edição do arquivo RC automaticamente!

Estou tentando gerar um .BAT para repassar o arquivo .RC para .RES que será compilado posteriormente pelo meu executável

Arquivo .RC

// RESOURCE SCRIPT generated by "Pelles C for Windows, version 7.00".

#include <windows.h>
#include <commctrl.h>
#include <richedit.h>

LANGUAGE LANG_ENGLISH,SUBLANG_ENGLISH_US

VS_VERSION_INFO VERSIONINFO
FILEVERSION 9,15,1,19
PRODUCTVERSION 9,15,1,19
FILEFLAGSMASK 0x3F
FILEFLAGS 0x0
FILEOS VOS__WINDOWS32
FILETYPE VFT_APP
FILESUBTYPE VFT2_UNKNOWN
{
  BLOCK "StringFileInfo"
  {
    BLOCK "041604B0"
    {
      VALUE "Comments", "Homologado com a versão 01.10 do PAF-ECF\0"
      VALUE "CompanyName", "RCA Sistemas LTDA\0"
      VALUE "FileDescription", "RCAPAF RCA - Programa de gerenciamento de farmácias\0"
      VALUE "FileVersion", "9.15.1.19\0"
      VALUE "InternalName", "RCAPAF.EXE\0"
      VALUE "LegalCopyright", "RCA Sistemas LTDA 2014\0"
      VALUE "LegalTrademarks", "RCA Sistemas\0"
      VALUE "OriginalFilename", "RCAPAF\0"
      VALUE "ProductName", "RCA DROGARIA\0"
      VALUE "ProductVersion", "9.15.1.19\0"
    }
  }
  BLOCK "VarFileInfo"
  {
    VALUE "Translation", 0x416, 0x4B0
  }
}

Já coloquei o caminho no Path do windows:

C:\Compiladores\bcc582;C:\Compiladores\bcc582\include

Não funcionou e copiei a pasta include para dentro da pasta bin do BCC e me retornou:

C:\Compiladores\bcc582\Bin>C:\Compiladores\bcc582\Bin\brc32.exe -r C:\Versoes\Farma\RCAPAF.RC

Borland Resource Compiler Version 5.40

Copyright © 1990, 1999 Inprise Corporation. All rights reserved.

Error prsht.h 1085 1: '#endif' before '#if'

C:\Compiladores\bcc582\Bin>cd C:\SVN\Fivewin\Ramos\2150\Farma

Você está apontando para o lugar certo?

IF EXIST %1.rc %bcdir%\bin\brc32 -r -I%bcdir%\include %1

Como assim?

Você diz pelo Path do windows?

No BAT

C:\Compiladores\bcc582\Bin\brc32.exe -r C:\Versoes\Farma\RCAPAF.RC

Utilizo xHarbour, BCC e o Pelles C junto do fivewin.

Gostaria de fazer um ajuste no arquivo .RES que contém a versão de forma automática para atualizar com um código auto incremento no bat pré-compilação.

Se fosse arquivo .RC eu conseguiria tratar pois é um arquivo texto formatado apenas, mas o BCC não consegue compilar o arquivo RC.

ola

obrigado por responder...

mas, verificar, onde exatamente ??

Você tem o fonte da VGet para poder analisar?

A equivalência para a TGET seria:

PastaFW\Source\Classes\Tget.prg

Verifica na vGet pois ela provavelmente já tem tratamento para as suas teclas

Você pode por um Say para ganhar o foco tb e no bOnGetFocus jogar o foco de volta para Get