sambomb

Achei o problema: //::cRetorno := ::oConecta:responsetext //-- Esse retorno fica errado! ::cRetorno := ::oConecta:ResponseBody

**************************************************************************** static procedure TestaEncode(cTexto) **************************************************************************** * * testar codificacao * Parametros: cTexto * Retorno: Nenhum * * Autor: Samir * 08/05/2015 - 14:42:50 * **************************************************************************** local aLinhas := {}, aResult := {} //Portuguese 850 HB_CODEPAGE_PT850 "PT850" cppt850.c //Portuguese ISO-8859-1 HB_CODEPAGE_PTISO "PTISO" cpptiso.c REQUEST HB_CODEPAGE_PT850 REQUEST HB_CODEPAGE_PTISO aLinhas := HB_ATokens(cTexto,CRLF) aAdd(aResult,{"Normal",aLinhas[3275]} ) If Sn("Testar 850") HB_SetCodePage( "PT850" ) aAdd(aResult,{"PT850",aLinhas[3275]} ) aAdd(aResult,{"PT850AnsitoOem", HB_AnsiToOem(aLinhas[3275]) } ) aAdd(aResult,{"PT850OemToAnsi", HB_OemToAnsi(aLinhas[3275]) } ) aAdd(aResult,{"PT850HB_STRTOUTF8", HB_STRTOUTF8(aLinhas[3275]) } ) aAdd(aResult,{"PT850HB_UTF8TOSTR", HB_UTF8TOSTR(aLinhas[3275]) } ) aAdd(aResult,{"PT850HB_Translate1", HB_Translate(aLinhas[3275],"PTISO","PT850") } ) aAdd(aResult,{"PT850_AnsitoOem", HB_AnsiToOem(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850_OemToAnsi", HB_OemToAnsi(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850_HB_STRTOUTF8", HB_STRTOUTF8(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850_HB_UTF8TOSTR", HB_UTF8TOSTR(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850HB_Translate2", HB_Translate(aLinhas[3275],"PT850","PTISO") } ) aAdd(aResult,{"PT850-AnsitoOem", HB_AnsiToOem(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850-OemToAnsi", HB_OemToAnsi(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850-HB_STRTOUTF8", HB_STRTOUTF8(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PT850-HB_UTF8TOSTR", HB_UTF8TOSTR(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) End If Sn("Testar ISO") HB_SetCodePage( "PTISO" ) aAdd(aResult,{"PTISO",aLinhas[3275]} ) aAdd(aResult,{"PTISOAnsitoOem", HB_AnsiToOem(aLinhas[3275]) } ) aAdd(aResult,{"PTISOOemToAnsi", HB_OemToAnsi(aLinhas[3275]) } ) aAdd(aResult,{"PTISOHB_STRTOUTF8", HB_STRTOUTF8(aLinhas[3275]) } ) aAdd(aResult,{"PTISOHB_UTF8TOSTR", HB_UTF8TOSTR(aLinhas[3275]) } ) aAdd(aResult,{"PTISOHB_Translate1", HB_Translate(aLinhas[3275],"PTISO","PT850") } ) aAdd(aResult,{"PTISO_AnsitoOem", HB_AnsiToOem(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISO_OemToAnsi", HB_OemToAnsi(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISO_HB_STRTOUTF8", HB_STRTOUTF8(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISO_HB_UTF8TOSTR", HB_UTF8TOSTR(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISOHB_Translate2", HB_Translate(aLinhas[3275],"PT850","PTISO") } ) aAdd(aResult,{"PTISO-AnsitoOem", HB_AnsiToOem(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISO-OemToAnsi", HB_OemToAnsi(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISO-HB_STRTOUTF8", HB_STRTOUTF8(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) aAdd(aResult,{"PTISO-HB_UTF8TOSTR", HB_UTF8TOSTR(HB_Translate(aLinhas[3275],"PTISO","PT850")) } ) End aShow(aResult,"Testes") Return Nil /*------------------------------------------------------------------------*/

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

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...

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

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

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

Com -r agora funcionou! 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:

Como assim? Você diz pelo Path do windows?

No BAT C:\Compiladores\bcc582\Bin\brc32.exe -r C:\Versoes\Farma\RCAPAF.RC C:\DROG9>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 RCAPAF.RC 3 11: Cannot open file: windows.h

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.

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