AVInfo Sistemas

Gente, será q alguém sabe ajustar o tamanho do campo memo no fast. Por exemplo: Eu tenho um campo com 50 caracteres na master data e o campo seguinte tem 300 caracteres, eu gostaria de saber c existe uma configuração no fast para ajustar o memo ao tamanho da informação, deixando espaçamento entre os registros mais justos a informação de uma maneira dinâmica. Por enquanto só consegui de uma maneira pré-definida junto ao assistente. Agradeço desde já ........ Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com Editado por - sdinfo on 06/02/2012 13:54:24 Editado por - sdinfo on 06/02/2012 16:06:25 Editado por - sdinfo on 06/02/2012 16:07:18

BOM DIA ALGUEM SABE OU TEM UM EXEMPLO DE COMO FAÇO PARA DAR DESCONTO EM % NUM ITEM NA DARUMA MACH 1 OBRIGADO LEONARDO Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

BOM DIA ALGUEM SABE OU TEM UM EXEMPLO DE COMO FAÇO PARA DAR DESCONTO EM % NUM ITEM NA DARUMA MACH 1 OBRIGADO LEONARDO Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

BOA TARDE OLHA SÓ TENHO UM VALOR 0,06 QUANDO COLOCO TRANSF(0.06 ,"@R 9999999,99") -> apresenta 0 QUANDO O VALOR É 1.60 POR EXEMPLO Dà CERTO FICA 1,60 QUANDO É 0.60 TAMBEM Dà ERRADO FICA 0 Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

BOA TARDE OLHA SÓ TENHO UM VALOR 0,06 QUANDO COLOCO TRANSF(0.06 ,"@R 9999999,99") -> apresenta 0 QUANDO O VALOR É 1.60 POR EXEMPLO Dà CERTO FICA 1,60 QUANDO É 0.60 TAMBEM Dà ERRADO FICA 0 Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

eu simplesmente gravo a consulta diretamente na tabela. Fica mais fácil e rápido. Pra quem usa SQL é mto mais prático. Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Pessoal, estou tendo dificuldade em liberar memória utilizando a minha aplicação. Fiz um pequeno programa que fica monitorando uma pasta que tem por objetivo armazenar os XML de NFe que deverão ser enviados por e-mail para os devidos destinatários. Aproveitei a classe que encontra-se aqui no forum para fazer, com algumas modificações funcionou direitinho o programa. O Problema que a cada XML lido, o programa vai alocando mais memória e não estou conseguindo liberar, o q eu devo fazer ? Já tentei CLEAR AREA, RELEASE ALL e nda ... Segue o código *********************************************************** #include "fivewin.ch" #include "Directry.ch" ******************************************************************************** fUNCTION MAIN() Local oApp, oTray, oIcon:=nil, oTimer:=nil, lUtil:=.F. IF ISEXERUNNING( CFILENAME( HB_ARGV( 0 ) ) ) MsgStop("O Programa SendEmail já está aberto neste computador, e por questões de segurança"; +" ele não poder ser aberto novamente.","A T E N Ç Ã O") QUIT ENDIF SET CENTURY ON SET DATE BRIT SET 3DLOOK ON DEFINE WINDOW oApp TITLE "Envio de Email" ICON oIcon ACTIVATE WINDOW oApp ON INIT ( oApp:Hide(),; ajustatempo(oApp,oTimer) ) VALID .f. //--------------------------------------------------------------------------------- FUNCTION ajustatempo(oApp,oTimer) //LOCAL nTpo := (60-val(substr(time(),7,2)))*1000 DEFINE TIMER oTimer OF oApp INTERVAL 1000 ACTION LOOCKUP(oApp,oTimer) oTimer:activate() //LOOCKUP() RETURN NIL //--------------------------------------------------------------------------------- FUNCTION LOOCKUP(oApp,oTimer) Private cPatch := cFilePath(hb_argv( 0 )) , cIni:=cFilePath(hb_argv( 0 ))+"SendEmail.ini" Private cEnvPatch := cPatch+"EnvioXML" Private cUser := Space(50), cPass := Space(15), cRemt := Space(50), ; cDest := Space(250), cTime, cTxt := Space(10), cAssunto := Space(200),; cCC := Space(250), cCCO := Space(250),lOk := .f. Private aServs := { {"@hotmail.com", "smtp.live.com", 25, .t. },; {"@yahoo.com.br", "smtp.mail.yahoo.com.br", 25, .f. },; {"@gmail.com.br", "smtp.gmail.com.br", 465, .t. },; {"@uol.com.br", "smtp.uol.com.br", 25, .f. },; {"@bol.com.br", "smtp.bol.com.br", 25, .f. },; {"@terra.com.br", "smtp.terra.com.br", 25, .f. },; {"@ig.com.br", "smtp.ig.com.br", 465, .t. },; {"@ibest.com.br", "smtp.ibest.com.br", 465, .t. },; {"@itelefonica.com.br","smtp.itelefonica.com.br", 25, .f. } } Private aDomin := {}, nServ := 1 Private aDir := {},aData:={},aAttach := {} , oIni oTimer:end() for i := 1 to len( aServs ) AADD( aDomin, aServs[1] ) next MakeDir(cEnvPatch) DirChange(cEnvPatch) IF !FILE(cIni) Criaresource() ENDIF lRet := .f. Aeval(aDir,{ |o| ADel(aDir,ASCAN(aDir,o))}) aSize(aDir,0) aSize(aData,0) aDir := Directory("*.xml") FOR n=1 To LEN(aDir) INI oIni FILE cIni GET cUser SECTION "Email Emitente" ENTRY "User" OF oIni GET cPass SECTION "Email Emitente" ENTRY "Pass" OF oIni GET cRemt SECTION "Email Emitente" ENTRY "Remetente" OF oIni GET nServ SECTION "Email Emitente" ENTRY "Dominio" OF oIni GET cAssunto SECTION "Email Emitente" ENTRY "Assunto" OF oIni GET cTxt SECTION "Email Emitente" ENTRY "Mensagem" OF oIni ENDINI cUser += Space(50-Len(cUser)) cPass += Space(15-Len(cPass)) cRemt += Space(50-Len(cRemt)) cAssunto += Space(200-Len(cAssunto)) ADDDATA(aDir[n,1],aData) cDest:= IF(!Empty(aData),aData[n,3],"") IF !Empty(cDest) cArq:= cEnvPatch+"\"+aDir[n,1] aSize(aAttach,0) AADD(aAttach,cArq) lRet := Config_Mail(cUser,cPass,cRemt,cDest, "", "",cTxt, cAssunto) ENDIF IF lRet MsgInfo("Email Enviado Com Sucesso!!!") FERASE(cArq) lRet := .f. ELSE MsgStop("Falha no Envio do Email!!!") ENDIF NEXT RELEASE ALL SYSREFRESH() ajustatempo(oApp,oTimer) return .t. //--------------------------------------------------------------------------------- Function CRIARESOURCE() local lSair := .f. local oDlg, oGet[ 8 ], oSay[12], oBtn[2], nItem := 0 local cDados, i for i := 1 to len( aServs ) AADD( aDomin, aServs[1] ) next DEFINE DIALOG oDlg TITLE "Configuração de Email" From 0, 0 to 620, 600 Pixel *****--- SAY's ---************************************************************** @ 002, 006 SAY oSay[1] PROMPT "Usuário - Somente o Nome" OF oDlg SIZE 100, 08 COLOR CLR_BLUE PIXEL @ 022, 006 SAY oSay[3] PROMPT "Senha" OF oDlg SIZE 50, 08 COLOR CLR_BLUE PIXEL @ 042, 006 SAY oSay[4] PROMPT "Remetente - Somente o Nome" OF oDlg SIZE 100, 08 COLOR CLR_BLUE PIXEL @ 052, 088 SAY oSay[2] PROMPT aDomin[nServ] OF oDlg SIZE 50, 08 COLOR CLR_BLACK PIXEL @ 094, 006 SAY oSay[9] VAR "Assunto" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL update @ 124,006 SAY oSay[7] VAR "Mensagem Padrão" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update *****OUTROS************************************************************* @ 010, 006 GET oGet[1] VAR cUser SIZE 80, 10 PIXEL OF oDlg PICTURE "@" Update oGet[1]:bValid := {|lRet| if(lRet := !Empty(cUser),(oGet[3]:VarPut(cUser), oGet[3]:Refresh()), ), .t. } @ 010, 088 COMBOBOX oComb VAR nServ ITEMS aDomin OF oDlg SIZE 100, 80 PIXEL; ON CHANGE (oSay[2]:SetText( aDomin[nServ] ) , MsgInfo(nServ) ) @ 030, 006 GET oGet[2] VAR cPass SIZE 80, 10 PIXEL OF oDlg Update oGet[2]:lPassWord := .T. @ 050, 006 GET oGet[3] VAR cRemt SIZE 80, 10 PIXEL OF oDlg PICTURE "@" Update @ 092, 040 GET oGet[6] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update @ 132,006 GET oGet[5] VAR cTxt OF oDlg SIZE 288, 70 COLOR CLR_BLUE, CLR_WHITE PIXEL update MEMO *****--- BOTÕES ---************************************************************* @ 290, 010 BUTTONBMP oBtn[1] PROMPT "Gravar" OF oDlg ; SIZE 30,10 PIXEL ; ACTION ( lOk:=.t., oDlg:End()) oBtn[1]:bWhen := {|| !Empty(cUser) } @ 290, 050 BUTTONBMP oBtn[2] PROMPT "Cancelar" OF oDlg ; SIZE 30,10 PIXEL ; ACTION ( oDlg:End() ) ACTIVATE DIALOG oDlg CENTERED IF lOK INI oIni FILE cIni SET SECTION "Email Emitente" ENTRY "User" TO ALLTRIM(cUser) OF oIni SET SECTION "Email Emitente" ENTRY "Pass" TO ALLTRIM(cPass) OF oIni SET SECTION "Email Emitente" ENTRY "Remetente" TO ALLTRIM(cRemt) OF oIni SET SECTION "Email Emitente" ENTRY "Dominio" TO nServ OF oIni SET SECTION "Email Emitente" ENTRY "Assunto" TO cAssunto OF oIni SET SECTION "Email Emitente" ENTRY "Mensagem" TO cTxt OF oIni ENDINI ENDIF return nil ******************************************************************************** Function Config_Mail(_cUser,cPass,_cRemt,cDest, cCC, cCCO, cTxt, cSubject) local lRet := .f. local oCfg, oError local cServ := aServs[nServ][2] //--> SERVIDOR SMTP - "smtp.servidor.com.br" local nPort := aServs[nServ][3] local lAut := .t. local lSSL := aServs[nServ][4] if Empty(cPass) .or. Empty(_cRemt) .or. Empty(cDest) ? "Preencha todos Campos" return .f. else cUser := alltrim(_cUser) + aDomin[nServ] cRemt := alltrim(_cRemt) + aDomin[nServ] endif TRY oCfg := CREATEOBJECT( "CDO.Configuration" ) WITH OBJECT oCfg:Fields :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServ :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := nPort :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := lAut :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lSSL :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := cUser :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := cPass :Update() END WITH lRet := .t. CATCH oError MsgInfo( "Não Foi possível Enviar o e-Mail!" +CRLF+ ; "Error: " + Transform(oError:GenCode, nil) + ";" +CRLF+ ; "SubC: " + Transform(oError:SubCode, nil) + ";" +CRLF+ ; "OSCode: " + Transform(oError:OsCode, nil) + ";" +CRLF+ ; "SubSystem: " + Transform(oError:SubSystem, nil) + ";" +CRLF+ ; "Mensaje: " + oError:Description, "Atenção" ) END //--> FIM DAS CONFIGURAÇOES. if lRet lRet := Envia_Mail(oCfg,cRemt,cDest, cCC, cCCO, cTxt, cSubject) //MemoWrit("dadosmail.dat", _cUSER+CRLF+_cREMT+CRLF+Str(nServ)) endif Return lRet ******************************************************************************** Function Envia_Mail(oCfg,cFrom, cTo, cCC, cBCC, cMsg, cSubject) local cToken local lRet := .f. cTo := Destinatarios( cTo ) //--> PARA cCC := Destinatarios( cCC ) //--> COM COPIA cBCC := Destinatarios( cBCC ) //--> COM COPIA OCULTA TRY oMsg := CREATEOBJECT ( "CDO.Message" ) WITH OBJECT oMsg :Configuration = oCfg :From = cFrom :To = cTo :CC = cCC :BCC = cBCC :Subject = cSubject :TextBody = cMsg For x := 1 To Len( aAttach ) if aAttach[x] <> NIL :AddAttachment(AllTrim(aAttach[x])) endif Next :Send() END WITH lRet := .t. RELEASE oMsg RELEASE oCfg CATCH MsgInfo("Não Foi Possível enviar a mensagem") lRet := .f. END Return lRet //---------------------------------------------------------------- Function ADDItem() Local cArq := cGetFile32("*.*", "ADD Anexo", , ,.f.) if file(cArq) oList:ADD(Alltrim(cArq)) oList:Hide() oList:Refresh() oList:Show() endif Return NIL //---------------------------------------------------------------- Function DELItem() Local nIT := oList:GetSel() oList:DEL( nIT ) oList:Hide() oList:Refresh() oList:Show() Return NIL //------------------------------------------------------------ Function Destinatarios( cVar ) local i local aCars := {",", "/", "\"} for i := 1 to len( aCars ) cVar := StrTran( cVar, aCars, ";" ) next Return cVar *********************************************************** ********** XML ******************************************* FUNCTION ADDDATA(cFile,aData) LOCAL oXmlDoc := TXmlDocument():new() LOCAL oXmlNode, aStruct := {} LOCAL cClie := cEmail := cNFe := cStatus := "" Local nFileHandle := 0 nFileHandle := FOpen( cFile , 0 ) oXMlDoc:read( nFileHandle ) oXmlNode := oXmlDoc:findFirst("ide") oXmlRecScan := TXmlIteratorScan():new( oXmlNode ) oXmlNode := oXmlRecScan:find( "nNF" ) cNFe := STRZERO(VAL(oXmlNode:cData),8) oXmlNode := oXmlDoc:findFirst("dest") oXmlRecScan := TXmlIteratorScan():new( oXmlNode ) oXmlNode := oXmlRecScan:find( "xNome" ) cClie := PRIMAISC(oXmlNode:cData) oXmlNode := oXmlRecScan:find( "email" ) cEmail := Lower(oXmlNode:cData) AADD(aData,{cNFe,cClie,cEmail,cStatus}) FClose(nFileHandle) RETURN .T. //------------------------------------------------------------ FUNCTION PRIMAISC(cText) cText := TokenUpper(Lower(ALLTRIM(cText))) cText := STRTRAN(cText," Da "," da ") cText := STRTRAN(cText," De "," de ") cText := STRTRAN(cText," Di "," di ") cText := STRTRAN(cText," Do "," do ") cText := STRTRAN(cText," Du "," du ") cText := STRTRAN(cText," O "," o ") cText := STRTRAN(cText," A "," a ") cText := STRTRAN(cText," E "," e ") cText := STRTRAN(cText," I "," i ") RETURN cText id=code>id=code>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Pessoal, estou tendo dificuldade em liberar memória utilizando a minha aplicação. Fiz um pequeno programa que fica monitorando uma pasta que tem por objetivo armazenar os XML de NFe que deverão ser enviados por e-mail para os devidos destinatários. Aproveitei a classe que encontra-se aqui no forum para fazer, com algumas modificações funcionou direitinho o programa. O Problema que a cada XML lido, o programa vai alocando mais memória e não estou conseguindo liberar, o q eu devo fazer ? Já tentei CLEAR AREA, RELEASE ALL e nda ... Segue o código *********************************************************** #include "fivewin.ch" #include "Directry.ch" ******************************************************************************** fUNCTION MAIN() Local oApp, oTray, oIcon:=nil, oTimer:=nil, lUtil:=.F. IF ISEXERUNNING( CFILENAME( HB_ARGV( 0 ) ) ) MsgStop("O Programa SendEmail já está aberto neste computador, e por questões de segurança"; +" ele não poder ser aberto novamente.","A T E N Ç Ã O") QUIT ENDIF SET CENTURY ON SET DATE BRIT SET 3DLOOK ON DEFINE WINDOW oApp TITLE "Envio de Email" ICON oIcon ACTIVATE WINDOW oApp ON INIT ( oApp:Hide(),; ajustatempo(oApp,oTimer) ) VALID .f. //--------------------------------------------------------------------------------- FUNCTION ajustatempo(oApp,oTimer) //LOCAL nTpo := (60-val(substr(time(),7,2)))*1000 DEFINE TIMER oTimer OF oApp INTERVAL 1000 ACTION LOOCKUP(oApp,oTimer) oTimer:activate() //LOOCKUP() RETURN NIL //--------------------------------------------------------------------------------- FUNCTION LOOCKUP(oApp,oTimer) Private cPatch := cFilePath(hb_argv( 0 )) , cIni:=cFilePath(hb_argv( 0 ))+"SendEmail.ini" Private cEnvPatch := cPatch+"EnvioXML" Private cUser := Space(50), cPass := Space(15), cRemt := Space(50), ; cDest := Space(250), cTime, cTxt := Space(10), cAssunto := Space(200),; cCC := Space(250), cCCO := Space(250),lOk := .f. Private aServs := { {"@hotmail.com", "smtp.live.com", 25, .t. },; {"@yahoo.com.br", "smtp.mail.yahoo.com.br", 25, .f. },; {"@gmail.com.br", "smtp.gmail.com.br", 465, .t. },; {"@uol.com.br", "smtp.uol.com.br", 25, .f. },; {"@bol.com.br", "smtp.bol.com.br", 25, .f. },; {"@terra.com.br", "smtp.terra.com.br", 25, .f. },; {"@ig.com.br", "smtp.ig.com.br", 465, .t. },; {"@ibest.com.br", "smtp.ibest.com.br", 465, .t. },; {"@itelefonica.com.br","smtp.itelefonica.com.br", 25, .f. } } Private aDomin := {}, nServ := 1 Private aDir := {},aData:={},aAttach := {} , oIni oTimer:end() for i := 1 to len( aServs ) AADD( aDomin, aServs[1] ) next MakeDir(cEnvPatch) DirChange(cEnvPatch) IF !FILE(cIni) Criaresource() ENDIF lRet := .f. Aeval(aDir,{ |o| ADel(aDir,ASCAN(aDir,o))}) aSize(aDir,0) aSize(aData,0) aDir := Directory("*.xml") FOR n=1 To LEN(aDir) INI oIni FILE cIni GET cUser SECTION "Email Emitente" ENTRY "User" OF oIni GET cPass SECTION "Email Emitente" ENTRY "Pass" OF oIni GET cRemt SECTION "Email Emitente" ENTRY "Remetente" OF oIni GET nServ SECTION "Email Emitente" ENTRY "Dominio" OF oIni GET cAssunto SECTION "Email Emitente" ENTRY "Assunto" OF oIni GET cTxt SECTION "Email Emitente" ENTRY "Mensagem" OF oIni ENDINI cUser += Space(50-Len(cUser)) cPass += Space(15-Len(cPass)) cRemt += Space(50-Len(cRemt)) cAssunto += Space(200-Len(cAssunto)) ADDDATA(aDir[n,1],aData) cDest:= IF(!Empty(aData),aData[n,3],"") IF !Empty(cDest) cArq:= cEnvPatch+"\"+aDir[n,1] aSize(aAttach,0) AADD(aAttach,cArq) lRet := Config_Mail(cUser,cPass,cRemt,cDest, "", "",cTxt, cAssunto) ENDIF IF lRet MsgInfo("Email Enviado Com Sucesso!!!") FERASE(cArq) lRet := .f. ELSE MsgStop("Falha no Envio do Email!!!") ENDIF NEXT RELEASE ALL SYSREFRESH() ajustatempo(oApp,oTimer) return .t. //--------------------------------------------------------------------------------- Function CRIARESOURCE() local lSair := .f. local oDlg, oGet[ 8 ], oSay[12], oBtn[2], nItem := 0 local cDados, i for i := 1 to len( aServs ) AADD( aDomin, aServs[1] ) next DEFINE DIALOG oDlg TITLE "Configuração de Email" From 0, 0 to 620, 600 Pixel *****--- SAY's ---************************************************************** @ 002, 006 SAY oSay[1] PROMPT "Usuário - Somente o Nome" OF oDlg SIZE 100, 08 COLOR CLR_BLUE PIXEL @ 022, 006 SAY oSay[3] PROMPT "Senha" OF oDlg SIZE 50, 08 COLOR CLR_BLUE PIXEL @ 042, 006 SAY oSay[4] PROMPT "Remetente - Somente o Nome" OF oDlg SIZE 100, 08 COLOR CLR_BLUE PIXEL @ 052, 088 SAY oSay[2] PROMPT aDomin[nServ] OF oDlg SIZE 50, 08 COLOR CLR_BLACK PIXEL @ 094, 006 SAY oSay[9] VAR "Assunto" OF oDlg SIZE 35, 08 COLOR CLR_BLUE PIXEL update @ 124,006 SAY oSay[7] VAR "Mensagem Padrão" OF oDlg SIZE 80, 08 COLOR CLR_BLUE PIXEL update *****OUTROS************************************************************* @ 010, 006 GET oGet[1] VAR cUser SIZE 80, 10 PIXEL OF oDlg PICTURE "@" Update oGet[1]:bValid := {|lRet| if(lRet := !Empty(cUser),(oGet[3]:VarPut(cUser), oGet[3]:Refresh()), ), .t. } @ 010, 088 COMBOBOX oComb VAR nServ ITEMS aDomin OF oDlg SIZE 100, 80 PIXEL; ON CHANGE (oSay[2]:SetText( aDomin[nServ] ) , MsgInfo(nServ) ) @ 030, 006 GET oGet[2] VAR cPass SIZE 80, 10 PIXEL OF oDlg Update oGet[2]:lPassWord := .T. @ 050, 006 GET oGet[3] VAR cRemt SIZE 80, 10 PIXEL OF oDlg PICTURE "@" Update @ 092, 040 GET oGet[6] VAR cAssunto SIZE 254, 10 PIXEL OF oDlg PICTURE "@" Update @ 132,006 GET oGet[5] VAR cTxt OF oDlg SIZE 288, 70 COLOR CLR_BLUE, CLR_WHITE PIXEL update MEMO *****--- BOTÕES ---************************************************************* @ 290, 010 BUTTONBMP oBtn[1] PROMPT "Gravar" OF oDlg ; SIZE 30,10 PIXEL ; ACTION ( lOk:=.t., oDlg:End()) oBtn[1]:bWhen := {|| !Empty(cUser) } @ 290, 050 BUTTONBMP oBtn[2] PROMPT "Cancelar" OF oDlg ; SIZE 30,10 PIXEL ; ACTION ( oDlg:End() ) ACTIVATE DIALOG oDlg CENTERED IF lOK INI oIni FILE cIni SET SECTION "Email Emitente" ENTRY "User" TO ALLTRIM(cUser) OF oIni SET SECTION "Email Emitente" ENTRY "Pass" TO ALLTRIM(cPass) OF oIni SET SECTION "Email Emitente" ENTRY "Remetente" TO ALLTRIM(cRemt) OF oIni SET SECTION "Email Emitente" ENTRY "Dominio" TO nServ OF oIni SET SECTION "Email Emitente" ENTRY "Assunto" TO cAssunto OF oIni SET SECTION "Email Emitente" ENTRY "Mensagem" TO cTxt OF oIni ENDINI ENDIF return nil ******************************************************************************** Function Config_Mail(_cUser,cPass,_cRemt,cDest, cCC, cCCO, cTxt, cSubject) local lRet := .f. local oCfg, oError local cServ := aServs[nServ][2] //--> SERVIDOR SMTP - "smtp.servidor.com.br" local nPort := aServs[nServ][3] local lAut := .t. local lSSL := aServs[nServ][4] if Empty(cPass) .or. Empty(_cRemt) .or. Empty(cDest) ? "Preencha todos Campos" return .f. else cUser := alltrim(_cUser) + aDomin[nServ] cRemt := alltrim(_cRemt) + aDomin[nServ] endif TRY oCfg := CREATEOBJECT( "CDO.Configuration" ) WITH OBJECT oCfg:Fields :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserver" ):Value := cServ :Item( "http://schemas.microsoft.com/cdo/configuration/smtpserverport" ):Value := nPort :Item( "http://schemas.microsoft.com/cdo/configuration/sendusing" ):Value := 2 :Item( "http://schemas.microsoft.com/cdo/configuration/smtpauthenticate" ):Value := lAut :Item( "http://schemas.microsoft.com/cdo/configuration/smtpusessl" ):Value := lSSL :Item( "http://schemas.microsoft.com/cdo/configuration/sendusername" ):Value := cUser :Item( "http://schemas.microsoft.com/cdo/configuration/sendpassword" ):Value := cPass :Update() END WITH lRet := .t. CATCH oError MsgInfo( "Não Foi possível Enviar o e-Mail!" +CRLF+ ; "Error: " + Transform(oError:GenCode, nil) + ";" +CRLF+ ; "SubC: " + Transform(oError:SubCode, nil) + ";" +CRLF+ ; "OSCode: " + Transform(oError:OsCode, nil) + ";" +CRLF+ ; "SubSystem: " + Transform(oError:SubSystem, nil) + ";" +CRLF+ ; "Mensaje: " + oError:Description, "Atenção" ) END //--> FIM DAS CONFIGURAÇOES. if lRet lRet := Envia_Mail(oCfg,cRemt,cDest, cCC, cCCO, cTxt, cSubject) //MemoWrit("dadosmail.dat", _cUSER+CRLF+_cREMT+CRLF+Str(nServ)) endif Return lRet ******************************************************************************** Function Envia_Mail(oCfg,cFrom, cTo, cCC, cBCC, cMsg, cSubject) local cToken local lRet := .f. cTo := Destinatarios( cTo ) //--> PARA cCC := Destinatarios( cCC ) //--> COM COPIA cBCC := Destinatarios( cBCC ) //--> COM COPIA OCULTA TRY oMsg := CREATEOBJECT ( "CDO.Message" ) WITH OBJECT oMsg :Configuration = oCfg :From = cFrom :To = cTo :CC = cCC :BCC = cBCC :Subject = cSubject :TextBody = cMsg For x := 1 To Len( aAttach ) if aAttach[x] <> NIL :AddAttachment(AllTrim(aAttach[x])) endif Next :Send() END WITH lRet := .t. RELEASE oMsg RELEASE oCfg CATCH MsgInfo("Não Foi Possível enviar a mensagem") lRet := .f. END Return lRet //---------------------------------------------------------------- Function ADDItem() Local cArq := cGetFile32("*.*", "ADD Anexo", , ,.f.) if file(cArq) oList:ADD(Alltrim(cArq)) oList:Hide() oList:Refresh() oList:Show() endif Return NIL //---------------------------------------------------------------- Function DELItem() Local nIT := oList:GetSel() oList:DEL( nIT ) oList:Hide() oList:Refresh() oList:Show() Return NIL //------------------------------------------------------------ Function Destinatarios( cVar ) local i local aCars := {",", "/", "\"} for i := 1 to len( aCars ) cVar := StrTran( cVar, aCars, ";" ) next Return cVar *********************************************************** ********** XML ******************************************* FUNCTION ADDDATA(cFile,aData) LOCAL oXmlDoc := TXmlDocument():new() LOCAL oXmlNode, aStruct := {} LOCAL cClie := cEmail := cNFe := cStatus := "" Local nFileHandle := 0 nFileHandle := FOpen( cFile , 0 ) oXMlDoc:read( nFileHandle ) oXmlNode := oXmlDoc:findFirst("ide") oXmlRecScan := TXmlIteratorScan():new( oXmlNode ) oXmlNode := oXmlRecScan:find( "nNF" ) cNFe := STRZERO(VAL(oXmlNode:cData),8) oXmlNode := oXmlDoc:findFirst("dest") oXmlRecScan := TXmlIteratorScan():new( oXmlNode ) oXmlNode := oXmlRecScan:find( "xNome" ) cClie := PRIMAISC(oXmlNode:cData) oXmlNode := oXmlRecScan:find( "email" ) cEmail := Lower(oXmlNode:cData) AADD(aData,{cNFe,cClie,cEmail,cStatus}) FClose(nFileHandle) RETURN .T. //------------------------------------------------------------ FUNCTION PRIMAISC(cText) cText := TokenUpper(Lower(ALLTRIM(cText))) cText := STRTRAN(cText," Da "," da ") cText := STRTRAN(cText," De "," de ") cText := STRTRAN(cText," Di "," di ") cText := STRTRAN(cText," Do "," do ") cText := STRTRAN(cText," Du "," du ") cText := STRTRAN(cText," O "," o ") cText := STRTRAN(cText," A "," a ") cText := STRTRAN(cText," E "," e ") cText := STRTRAN(cText," I "," i ") RETURN cText id=code>id=code>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

alguem tem alguma solução ?? Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Na verdade não, eu gostaria d monitorar a area d transferência em busca d links d download. Toda vez q eu copio um link para a area d transferência chame o programa que deverá estar em background para trabalhar o link, eu fiz um inversor d link para os sites d download bloqueados e gostaria d usá-lo pra trabalhar em conjunto com o gerenciador d download jdownloader. Agraço pela ajuda citação:Não entendi... Algo assim? http://info.abril.com.br/dicas/arquivo/recuperacao/o-ditto-monitora-e-grava-itens-copiados-para-a-area-de-transferencia.shtml João Santos - São Paulo. kmt_karinha@pop.com.br joao@pleno.com.br Fone: (11) 3106-2832 / 8243-5632 - TIM FWH 2.7 - xHARBOUR WorkShop.Exe Editado por - kapiaba on 21/07/2011 10:24:02 id=quote>id=quote>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Alguém sabe como eu devo proceder pra monitorar a area d transferência do Windows ? A minha idéia é criar um timer q trabalhe de 1,5 s pra monitorar a area d transferência, mas precisa saber como proceder. Aguardo algumas dicas e agradeço desde já ... Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Alguém sabe como eu devo proceder pra monitorar a area d transferência do Windows ? A minha idéia é criar um timer q trabalhe de 1,5 s pra monitorar a area d transferência, mas precisa saber como proceder. Aguardo algumas dicas e agradeço desde já ... Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Amigão show d Bola Funcionou direitinho. Obrigado pela ajuda e abraços. citação:Amigo, será que é isso que voce deseja se for isso antes do get coloque algo assim *-------------------------------------------------------------------------- oFld_CHEQUES:aDialogs[ 2 ]:bPainted := { | hDC | PalBmpDraw( hDC, 09, 02, oPapel:hBitMap,oPapel:hPalette,oFld_CHEQUES:aDialogs[ 2 ]:nRight*0.98,oFld_CHEQUES:aDialogs[ 2 ]:nBottom*0.67) } informaisvrb@gmail.com msn mastermarvrb@msn.com 32-9104-0562 id=quote>id=quote>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

vou tentar amigao, obrigado pela ajuda, volto pra postar o resultado. Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Boa tarde galera, estou tendo problema com uma imagem d fundo. Uso resources. Estou tentando colocar alguns Gets acima de um Bitmap. Primeiramente eu coloquei o Bitmap acima dos Gets na declaração do arquivo .rc, por conta disso, os Gets não recebiam o cursor do mouse, somente com o TAB e ENTER. Então troquei a ordem do Bitmap para ficar após os Gets, então eles recuperaram o cursos pelo mouse, mas ao pintar a tela ... eles parecem estar em segundo plano ao Bitmap, somente aparecem se eu passar o mouse sobre eles. Bitmap Antes dos Gets no Resource Bitmap Depois dos Gets no Resource Agradeço a Ajuda ... Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com Editado por - sdinfo on 19/07/2011 10:26:56

Boa tarde galera, estou tendo problema com uma imagem d fundo. Uso resources. Estou tentando colocar alguns Gets acima de um Bitmap. Primeiramente eu coloquei o Bitmap acima dos Gets na declaração do arquivo .rc, por conta disso, os Gets não recebiam o cursor do mouse, somente com o TAB e ENTER. Então troquei a ordem do Bitmap para ficar após os Gets, então eles recuperaram o cursos pelo mouse, mas ao pintar a tela ... eles parecem estar em segundo plano ao Bitmap, somente aparecem se eu passar o mouse sobre eles. Bitmap Antes dos Gets no Resource Bitmap Depois dos Gets no Resource Agradeço a Ajuda ... Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com Editado por - sdinfo on 19/07/2011 10:26:56

Olá pessoal, estou tendo problemas pra calcular o valor horizontal dos pixels de um say preenchido. Tenho a necessidade de calcular exatamente o espaço até chegar a margem da Dialog e depois quebra linha para o próximo Say no caso d preencher tdo o espaço do primeiro. Como eu devo proceder ? Agradeço desde já!!! Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Olá pessoal, estou tendo problemas pra calcular o valor horizontal dos pixels de um say preenchido. Tenho a necessidade de calcular exatamente o espaço até chegar a margem da Dialog e depois quebra linha para o próximo Say no caso d preencher tdo o espaço do primeiro. Como eu devo proceder ? Agradeço desde já!!! Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

sim .... gente eu descobri o pq ... faltou o start transaction e o end transaction durante a consulta ao banco. Utilizo isso na persistência mas nã usei na consulta. Mto Obrigado a Todos. Problema Resolvido !!! Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com Editado por - sdinfo on 11/04/2011 15:15:36 Editado por - sdinfo on 11/04/2011 15:15:57

Segue um trecho do código: //Aqui eu insiro os dados do kbçalho d uma cotação cColumnsSql := ; "NumOrc31,NomCli31,DtaMov31,CasDec31,TipLic31,"+; "CovOrc31,AneOrc31,PrtOrc31,ValOrc31,PzoOrc31,"+; "FreOrc31,ImpOrc31,AttOrc31,ForPag31,NumEdi31,"+; "VigOrc31,ProPro31,DtaVig31,TemTro31,TemReg31,"+; "TemBoa31,TemCre31,TemLau31,TemRea31,TemCer31,"+; "TemMul31,CodCli31,CodVen31,TotOrc31,ProOrc31,"+; "FatMin31,EncOrc31,VpdOrc31,PzoCon31,ObsOrc31,"+; "LocEnt31,AmoOrc31,NomRep31,ValCon31" aSetCampos := {; clNum,clNcli,clEmi,nlDec,LEFT(clTipo,1),; clCov,clAne,clProt,clVpro,clPzo,; clFret,clImpo,clAtt,clPaga,clEdi,; clVig,clProc,clDvig,LEFT(clTroca,1),LEFT(clRegis,1),; LEFT(clBoa,1),LEFT(clCrede,1),LEFT(clLaudo,1),LEFT(clReaj,1),LEFT(clCert,1),; LEFT(clMult,1),clCcli,clCven,nlTot,clPro,; nlFat,clAbe,clVprod,clContra,clObs,; clLoc,clAmo,clRepr,nlVcon; } InsertBD("Orcam31i",cColumnsSql,aSetCampos) //Aqui é a função de inserção genérica /* Parâmetros cTabela -> Nome da Tabela cColumnsSql -> String Colunas da Tabela SQL aSetCampos -> Variáveis correspondentes a inserção */ FUNCTION InsertBD(cTabela, cColumnsSql, aSetCampos,lCommit) Local cSql:="" //BLOCO DE INSERÇÃO cSql:="insert into " + (cTabela) + "(" + cColumnsSql + ") " +; "values(" FOR I = 1 TO LEN (aSetCampos) IF I cSql:=cSql + "$" + Alltrim(CSTR(I)) + "," ELSE cSql:=cSql + "$" + Alltrim(CSTR(I)) ENDIF NEXT cSql:=cSql+")" //INICIA A TRANSAÇÃO COM O BD START TRANSACTION SQL EXECUTE cSql WITH ARRAY (aSetCampos) /*VERIFICA SE HOUVE ERRO NA INSERÇÃO *SE HOUVER ELE Dà UM ROLLBACK NA TRANSAÇÃO */ IF SQLErrorNO()> 0 MsgStop( "Não foi possível gravar os dados na tabela "+cTabela+; CRLF + "Informe a mensagem abaixo ao suporte : "+CRLF+CRLF+; SQLErrorMsg(), "Erro") ROLLBACK TRANSACTION END TRANSACTION QUIT Return( .F. ) ENDIF If lCommit = nil .or. lCommit = .f. //COMITA A TRANSAÇÃO EM CASO DE SUCESSO COMMIT TRANSACTION ENDIF //ENCERRA A TRANSACÇÃO END TRANSACTION RETURN (.T.) *--------------------------------------------------------------------------------- //e aqui a consulta na tabela da Xbrowse de cotação // Por EWERTON COSTA - 17/01/2011 // // AÇÃO // ORDENA AS LINHAS DA XBROWSE DE Itens de cotação DE ACORDO COM O COMBO DE ORDENAÇÃO // // PARÂMETROS // oCombo => Combobox de Ordenação // OBRW => XBROWSE a Ser modificada // fBold => Fonte em Negrito // nOrd -> Indica a ordem q a COluna deve ser ordenadas (1 -asc , 2 -desc) //----------------------------------------------------------------------------// FUNCTION SetOrderObrwLic(oCombo,oBRW,nOrd,oGet) Local cField := oCombo:aItems[oCombo] Local nCol := 0 Local cOrder := IF(nOrd == 1,"A","D") //Icone de Ordenação Local cOrderBy := "" //Tipo de Ordenação Local cOrd := IF(nOrd == 1, "asc", "desc") //recebe a odenação DEFINE FONT fBold NAME "MS Sans Serif" BOLD DEFINE FONT oFnt NAME "Arial" SIZE 0, -12 BOLD CursorWait() oGet:oGet:Picture := "@!";oGet:cText(Space(200));oGet:Refresh() cSql := " Select * from orcam31i " DO CASE CASE cField = "Data" oGet:oGet:Picture := "99/99/9999A";oGet:Refresh() cSql += " force index (sr_recno) " cOrderBy := " Order by dtamov31 " + cOrd + " , numorc31 " + cOrd nCol := 1 CASE cField = "Número" cSql += " force index (sr_recno) " cOrderBy := " Order by numorc31 " + cOrd nCol := 2 CASE cField = "Cliente" .or. cField = "<> Cliente" cSql += " force index (idx_nomcli31) " cOrderBy := " Order by nomcli31 " + cOrd nCol := 4 OTHERWISE ENDCASE cSql += cOrderBy + " limit 2000 " AbreAlias("orcam31i","orcam31i",cSql,.t.) AEval( oBRW:aCols, { |o| o:bClrHeader:= oBRW:bClrHeader}) //Reinicia Cor de Cabeçalho AEval( oBRW:aCols, { |o| o:oHeaderFont := oFnt}) //Reinicia Fonte Cabeçalho AEval( oBRW:aCols, { |o| o:cOrder := "" } ) oBRW:aCols[nCol]:cOrder := cOrder oBRW:aCols[nCol]:oHeaderFont := fBold oBRW:aCols[nCol]:bClrHeader := {||{CLR_BLACK,CLR_CREME}} oBrw:GOTOP() oBRW:Refresh() CursorArrow() RETURN cSql //----------------------------------------------------------------------------// // E aqui a função de abertura d área genérica /* Parametros: cTabela : Nome da Tabela do BD a ser aberta cAlias : Nome do Alias que será usado cSql: Se passado, a funcao entende que é pra executar instrucao sql, via mysql cRDD : nome da rdd q vai usar exemplo: "MYSQL" OU "DBFCDX" */ FUNCTION AbreAlias( cTabela,cAlias,cSQl,lShared) IF(Select(cAlias)!=0) &(cAlias)->(DbCloseArea()) ENDIF IF Table(cTabela) IF(!EMPTY(cSql) .and. cSql != nil) IF(lShared) USE SQL cSQl ALIAS (cAlias) Shared New via "MYSQL" ELSE USE SQL cSQl ALIAS (cAlias) New via "MYSQL" ENDIF ELSE IF(lShared) USE &(cTabela) ALIAS (cAlias) Shared New via "MYSQL" ELSE USE &(cTabela) ALIAS (cAlias) New via "MYSQL" ENDIF ENDIF ELSE MsgStop( "Tabela " + cTabela + " Não Existe no Banco !" ) QUIT ENDIF RETURN( .T. ) //------------------------------------------------------------------------ id=code>id=code>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

estou usando a SQLLib, em dois terminais tenho rodando o sistema, insiro os dados em 1 e no outro não dá o refresh qndo puxo uma consulta, o dado novo não aparece. O q pode ser ? Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Bom dia pessoal. Estou tendo problemas em atualizar os dados nos diversos terminais da rede. Recentemente migrei a base d dados d um programa d DBF para Mysql. Agora ao fazer os testes, inserindo dados em dois terminais diferentes, observei q c os dados forem inseridos em 1 terminal, não são atualizados no outros, mesmo vc requisitando os dados novamente através de consultas. Somente atualiza qndo c fecha e abre novamente o sistema, ou seja, qndo a conexao é refeita. O q devo fazer pra q os dados sejam atualizados ? Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com Editado por - sdinfo on 11/04/2011 10:23:11

Bom dia pessoal. Estou tendo problemas em atualizar os dados nos diversos terminais da rede. Recentemente migrei a base d dados d um programa d DBF para Mysql. Agora ao fazer os testes, inserindo dados em dois terminais diferentes, observei q c os dados forem inseridos em 1 terminal, não são atualizados no outros, mesmo vc requisitando os dados novamente através de consultas. Somente atualiza qndo c fecha e abre novamente o sistema, ou seja, qndo a conexao é refeita. O q devo fazer pra q os dados sejam atualizados ? Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com Editado por - sdinfo on 11/04/2011 10:23:11

Galera, estou testando aqui o Rollback do SQLLib para cancelar uma transação, mas não está cancelando aqui nesse teste, está comitando os dados normalmente, pq será? Segue o código: Function Main() ConectBD(0) BEGIN TRANSACTION For i:=1 To 10 cSql := "Insert into teste (name) values ("+STRZERO(i,2)+")" SQLEXECUTE(cSql) NEXT ?"Passou loop 1" For i:=1 To 10 cSql := "Update teste set name = "+STRZERO(0,2) SQLEXECUTE(cSql) NEXT ?"Passou loop 2" For i:=11 To 20 cSql := "insert teste (name) values ("+STRZERO(i,2)+")" SQLEXECUTE(cSql) NEXT ?"Passou loop 3" ROLLBACK TRANSACTION END TRANSACTION RETURN .T. //-------------------------------------------------------- id=code>id=code>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com

Galera, estou testando aqui o Rollback do SQLLib para cancelar uma transação, mas não está cancelando aqui nesse teste, está comitando os dados normalmente, pq será? Segue o código: Function Main() ConectBD(0) BEGIN TRANSACTION For i:=1 To 10 cSql := "Insert into teste (name) values ("+STRZERO(i,2)+")" SQLEXECUTE(cSql) NEXT ?"Passou loop 1" For i:=1 To 10 cSql := "Update teste set name = "+STRZERO(0,2) SQLEXECUTE(cSql) NEXT ?"Passou loop 2" For i:=11 To 20 cSql := "insert teste (name) values ("+STRZERO(i,2)+")" SQLEXECUTE(cSql) NEXT ?"Passou loop 3" ROLLBACK TRANSACTION END TRANSACTION RETURN .T. //-------------------------------------------------------- id=code>id=code>Xharbour 1.2.1 - Fw 10.10 - WS e Pelles tominem@hotmail.com