Rogerio Figueira

Bom dia Judson, Você poderia explicar melhor como fez isso? Como pega o nome do certificado? Eu tinha resolvido o problema desinstalando o warsaw mas o cliente insiste em usar o banco na mesma máquina (só tem uma) . Sds.

Ok, resolvido, obrigado. Era mesmo a tranca do warsaw GAS Tecnologia. []´s

Olá Valdir, obrigado pela resposta. Desinstalei o Itaú pelo painel de controle, o pc foi reiniciado mas continua na memória, visto pelo gerenciador de tarefas, o GAS tecnologie. Seria ele o motivo? Não achei onde desinstalar esse. []s

Boa tarde. Estou com um problema raro que nunca me aconteceu antes. Instalei o sistema atualizado para a NFe 4 em um cliente. Utilizo Flexdocs e vonfe2g_v4 do Gilmer. O programa está fechando abruptamente, sem qualquer aviso de erro nas seguintes condições: Ao executar o envio da NFe, nem chega a pedir o certificado. Ao executar a verificação da versão DLL com esta função também fecha abruptamente. Function VersaoDLL() Local oNfeUtil:=TVoNfeUtil2g():New(cEstadoEmitenteNFe,cTpAmb,GetPvProfString( "CONFIGURACAO", "CERTIFICADO", "", "VoNfeCertSign.Ini")) MsgInfo(oNfeUtil:Versao(),"NFeFlexDocs") oNfeUtil:End() Return .f. Fiz um teste com o CertFlex.exe e ele funciona ok, localiza o certificado e conecta sem erro. Durante várias tentativas por uma única vez consegui gerar o xml e enviar a nfe. Somente uma vez. Desconfiei de algum programa instalado, foi desinstalado o programa do Itaú. Continua funcionando na memória o GAS Tecnologie - Core que não sei se seria ele o motivo. Alguém tem idéia do que pode ser? []´s

Boa tarde. Te passo dois exemplos, funcionando ok. // // File attributes // #define FILE_ATTRIBUTE_READONLY 1 #define FILE_ATTRIBUTE_HIDDEN 2 #define FILE_ATTRIBUTE_SYSTEM 4 #define FILE_ATTRIBUTE_DIRECTORY 16 #define FILE_ATTRIBUTE_ARCHIVE 32 #define FILE_ATTRIBUTE_NORMAL 128 #define FILE_ATTRIBUTE_TEMPORARY 256 // // access types for InternetOpen() // #define INTERNET_OPEN_TYPE_PRECONFIG 0 // use registry configuration #define INTERNET_OPEN_TYPE_DIRECT 1 // direct to net #define INTERNET_OPEN_TYPE_PROXY 3 // via named proxy #define INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY 4 // prevent using java/script/INS // // manifests // #define INTERNET_INVALID_PORT_NUMBER 0 // use the protocol-specific default #define INTERNET_DEFAULT_FTP_PORT 21 // default for FTP servers #define INTERNET_DEFAULT_GOPHER_PORT 70 // " " gopher " #define INTERNET_DEFAULT_HTTP_PORT 80 // " " HTTP " #define INTERNET_DEFAULT_HTTPS_PORT 443 // " " HTTPS " #define INTERNET_DEFAULT_SOCKS_PORT 1080 // default for SOCKS firewall servers. // // service types for InternetConnect() // #define INTERNET_SERVICE_FTP 1 #define INTERNET_SERVICE_GOPHER 2 #define INTERNET_SERVICE_HTTP 3 #define INTERNET_FLAG_PASSIVE 134217728 // // flags for FTP // #define INTERNET_FLAG_TRANSFER_ASCII 1 #define INTERNET_FLAG_TRANSFER_BINARY 2 //------------------------------------------------------------------- FUNCTION MandaFTP(host, usuario, senha, pasta, arquivo, dir, oquefazer, QuemChamou) LOCAL hInternet, hConnect Local afiles hInternet = INTERNETOPEN( "Anystring", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0 ) hConnect = INTERNETCONNECT( hInternet, host, INTERNET_INVALID_PORT_NUMBER, usuario, senha, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 ) if oquefazer = "pega" if ! FTPGETFILE( hConnect, pasta+arquivo, arquivo, 0, FILE_ATTRIBUTE_ARCHIVE, 0, 0 ) msgStop("Erro ao receber arquivo "+pasta+arquivo,"Atenção!") else SumLog(arquivo, "Recebido por ","FTP ") end else if FTPPUTFILE( hConnect, dir+arquivo, pasta+arquivo, 0, 0 ) if QuemChamou = "WT5f0A" msginfo("Arquivo enviado.","Sucesso!") end // crio log da transacao SumLog(arquivo, "Enviado por ","FTP ") else msgalert("Falha no envio do arquivo"+CRLF+; "Verifique conexão com a internet e firewall.","Problemas.") SumLog(arquivo, "Falhou ao enviar ","FTP ") end end INTERNETCLOSEHANDLE( hConnect ) INTERNETCLOSEHANDLE( hInternet ) RETURN NIL //============================================================================================== FUNCTION MandaImg(host, usuario, senha, pasta, aJPG, dir, oquefazer, QuemChamou) LOCAL hInternet, hConnect local hFTPDir, aFiles := {} local oWin32FindData, cBuffer Local aonde, arquivo STRUCT oWin32FindData MEMBER nFileAttributes AS DWORD MEMBER nCreationTime AS STRING LEN 8 MEMBER nLastReadAccess AS STRING LEN 8 MEMBER nLastWriteAccess AS STRING LEN 8 MEMBER nSizeHight AS DWORD MEMBER nSizeLow AS DWORD MEMBER nReserved0 AS DWORD MEMBER nReserved1 AS DWORD MEMBER cFileName AS STRING LEN 260 MEMBER cAltName AS STRING LEN 14 ENDSTRUCT hInternet = INTERNETOPEN( "Anystring", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0 ) hConnect = INTERNETCONNECT( hInternet, host, INTERNET_INVALID_PORT_NUMBER, usuario, senha, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 ) if oquefazer = "vesetem" cBuffer = oWin32FindData:cBuffer hFTPDir = FtpFindFirstFile( hConnect, "*.*", @cBuffer, 0, 0 ) oWin32FindData:cBuffer = cBuffer if ! Empty( oWin32FindData:cFileName ) aadd( aFiles, { oWin32FindData:cFileName,; oWin32FindData:nSizeLow } ) while InternetFindNextFile( hFTPDir, @cBuffer ) oWin32FindData:cBuffer = cBuffer aadd( aFiles, { oWin32FindData:cFileName,; oWin32FindData:nSizeLow } ) end endif if len(afiles)>0 for i=1 to len(aJPG) aonde := ascan(afiles,aJpg[i]) if aonde > 0 adel(aJPG,aonde) //fica na matriz somente o que vai ser enviado end next else msgAlert("Erro ao carregar Dir Remoto."+CRLF+"Conexão falhou."+CRLF+"Gere o relatório novamente.","Atenção:") end else aJPg := {} end if len(aJPG)>0 for i=1 to len(aJPG) arquivo := aJPG[i] if FTPPUTFILE( hConnect, dir+arquivo, pasta+arquivo, 0, 0 ) if QuemChamou = "WT5f0A" msginfo("Arquivo enviado.","Sucesso!") end // crio log da transacao SumLog(arquivo, "Enviado por ","FTP ") else msgalert("Falha no envio do arquivo"+CRLF+; "dir+arquivo: "+dir+arquivo + CRLF+; "pasta+arquivo: "+pasta+arquivo+CRLF+; "Verifique conexão com a internet e firewall.","Problemas.") SumLog(arquivo, "Falhou ao enviar ","FTP ") end next end INTERNETCLOSEHANDLE( hConnect ) INTERNETCLOSEHANDLE( hInternet ) RETURN NIL //================================================================================================ #pragma BEGINDUMP #include "windows.h" #include "wininet.h" #include "hbapi.h" HB_FUNC( INTERNETOPEN ) { hb_retnl( ( LONG ) InternetOpen( hb_parc( 1 ), hb_parnl( 2 ), hb_parc( 3 ), hb_parc( 4 ), hb_parnl( 5 ) ) ); } HB_FUNC( INTERNETCLOSEHANDLE ) { hb_retl( InternetCloseHandle( ( HINTERNET ) hb_parnl( 1 ) ) ); } HB_FUNC( INTERNETCONNECT ) { hb_retnl( ( LONG ) InternetConnect( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), ( INTERNET_PORT ) hb_parnl( 3 ), hb_parc( 4 ), hb_parc( 5 ), hb_parnl( 6 ), hb_parnl( 7 ), hb_parnl( 8 ) ) ); } HB_FUNC( FTPGETFILE ) { hb_retl( FtpGetFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), hb_parc( 3 ), hb_parl( 4 ), hb_parnl( 5 ), hb_parnl( 6 ), hb_parnl( 7 ) ) ); } HB_FUNC( FTPPUTFILE ) { hb_retl( FtpPutFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), hb_parc( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ) ); } HB_FUNC( FTPDELETEFILE ) { hb_retl( FtpDeleteFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) ); } HB_FUNC( FTPCREATEDIRECTORY ) { hb_retl( FtpCreateDirectory( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) ); } HB_FUNC( FTPREMOVEDIRECTORY ) { hb_retl( FtpRemoveDirectory( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) ); } HB_FUNC( FTPFINDFIRSTFILE ) { hb_retnl( ( LONG ) FtpFindFirstFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), ( WIN32_FIND_DATA * ) hb_parc( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ) ); } HB_FUNC( INTERNETFINDNEXTFILE ) { hb_retl( InternetFindNextFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) ); } #pragma ENDDUMP

Theotokos, segue exemplo: Function MandaMail( destino, copia, arquivo) LOCAL host, usuario, senha, pasta LOCAL lret, cSubject, cMsg, comCopia:={} LOCAL s_ua:="Usuario Licenciado" if ! pegaconf(@host, @usuario, @senha, @pasta, @mailport) // pega dados de arquivo criptografado msgstop("Dados insuficientes para transmissão!","Falha fatal!") return .f. end lRet := Sendemeiu( alltrim(s_ua) +"<"+usuario+">", host, destino, cSubject, cMsg, alltrim(s_ua) +"<"+usuario+">", usuario, senha, {arquivo}, copia, .t., mailport, .t. ) IF ! lRet MsgAlert("Erro ao enviar o e-mail deste pedido."+CRLF+"Verifique acesso internet e tente novamente."+CRLF+; "usuario:"+usuario+CRLF+; "senha:"+senha+CRLF+; "host:"+host,"Atenção:") return .f. ENDIF return nil //========================== FUNCTION SendeMeiu( cFrom, cServer, cTo, cSubject, cMessage, cSender, cUser, cPassword, aAttach, aCc, lHtml, cPort, lNotification ) LOCAL cMsgFile := CTEMPFILE() LOCAL cCmd := "SndMail -f " + cFrom + " -X " + cServer + " -r " + cTo + " -s " + ["] + cSubject + ["] + " -b " + cMsgFile LOCAL nRes LOCAL i DEFAULT lHtml := "<html" $ LOWER( cMessage ) MEMOWRIT( cMsgFile, cMessage + CRLF ) IF !EMPTY( aAttach ) FOR i = 1 TO LEN( aAttach ) cCmd += " -a " + ["] + aAttach[ i ] + ["] NEXT ENDIF IF !EMPTY( cSender ) cCmd += " -F " + ["] + cSender + ["] ENDIF IF !EMPTY( cUser ) cCmd += " -h LOGIN -u " + cUser ENDIF IF !EMPTY( cPassword ) cCmd += " -p " + cPassword ENDIF IF !EMPTY( aCc ) FOR i = 1 TO LEN( aCc ) cCmd += " -c " + ["] + aCc[ i ] + ["] NEXT ENDIF IF lHtml cCmd += " -H" ENDIF IF !EMPTY( cPort ) cCmd += " -P " + cPort ENDIF IF !EMPTY( lNotification ) cCmd += " -t " + ["] + "Disposition-Notification-To: " + cFrom + ["] ENDIF hDLL = LOADLIBRARY( "sndmail.dll" ) IF hDll = 0 msgInfo("Não instalada sndmail.dll",":Atenção::") return .f. ELSE SMTPLIBOPEN() // OPEN sndmail.dll ENDIF nRes = SMTPSENDMAIL( cCmd ) SMTPLIBCLOSE() FREELIBRARY( hDLL ) // FERASE( cMsgFile ) RETURN nRes = 0 DLL STATIC FUNCTION SMTPLIBOPEN() AS VOID; PASCAL FROM "USmtpLibOpen" LIB hDll DLL STATIC FUNCTION SMTPSENDMAIL( cCmd AS STRING ) AS LONG; PASCAL FROM "USmtpCmdLineSendMail" LIB hDll DLL STATIC FUNCTION SMTPLIBCLOSE() AS VOID; PASCAL FROM "USmtpLibClose" LIB hDll // END OF PROGRAM

Passei a usar a sndmail.dll dica do nosso mestre Kapiaba, funciona que é uma maravilha. Tente ela.

Ok, resolvido. Obrigado Motta, obrigado a todos.

Olá a todos! Meus caros, já fiz a pesquisa nos fóruns não encontrei uma solução: cGetFile() retorna o nome completo do arquivo com o diretório dele, p. ex.: D:\eudora\attach\WP_20160121_18_52_26_Pro.jpg C:\Users\Roger\Pictures\24862434_10155278059854503_7218341658060414317_n.jpg Eu preciso além do que a função já retorna, a pasta, o nome do arquivo e o tamanho em bytes separados, p. ex.: D:\eudora\attach WP_20160121_18_52_26_Pro.jpg 88976 C:\Users\Roger\Pictures 24862434_10155278059854503_7218341658060414317_n.jpg 56432 Alguém tem ideia de como fazer isso? Tks.

Valdir, pelo que você disse, certamente foi restauração de backup. Pode as vezes acontecer de um ou outro registro se perder, mas não todo o banco de dados. Eu utilizo um sistema de log para todas as operações feitas nos programas de forma que dá para verificar quando o programa foi utilizado e por quem e todas inclusões, alterações e exclusões ficam documentadas. Também criei uma rotina de backup automático sempre que é feita a reindexação. []'s Rogerio

Evandro, a patir dos exemplos do FW eu criei minhas rotinas, funciona tudo bem, mas só habilito para clientes que usam hospedagem no meu servidor para evitar problemas com os gratuitos. Usa a classe Tpop3 do fw. Segue o código: //======================================================================================================= Function PegaoMail( ) local oOutMail, oIP, mailport := 587, mailauth LOCAL host, usuario, senha, pasta mailport := 587 mailauth := .T. if ! pegaconf(@host, @usuario, @senha ) // le os dados no arquivo de configuração msgstop("Dados insuficientes para transmissão!","Falha fatal!") return .f. end WsaStartUp() oIP :=GETHOSTBYNAME("mail.representantes.info") // aqui entra o servidor de email //msginfo(oIP,"oIP") If oIP = "0.0.0.0" DelLog:=.f. WsaCleanUp() msgAlert("E-mail não pode ser lido neste instante.","Atenção!") return .f. End GetMail(host, usuario, senha) sysrefresh() return nil //----------------------------------------------------------------------------// function GetMail(host, usuario, senha) local oInMail, oIP :=GETHOSTBYNAME(host) oInMail = TPop3():New( oIP,, usuario, senha ) // mail server IP oInMail:lDelMsgs := .t. oInMail:lHeaderOnly := .f. oInMail:bConnecting = { || Monitor( "Conectando em "+oIP ) } oInMail:bConnected = { || Monitor( "Conectado" ) } oInMail:bDone = { || ReadEmails( oInMail ) } oInMail:GetMail() return nil //----------------------------------------------------------------------------// function ReadEmails( oInMail ) local n for n = 1 to Len( oInMail:aMsgs ) salvamail( oInMail:aMsgs[ n ] ) next return nil //------------------------------------------------------------ function salvamail(mensagem) LOCAL cFrom := cSubject := cDate := "" , y := mlcount(mensagem) if y>0 for i = 1 to y if subs(memoline(mensagem,100,i),1,5) = "From:" cFrom := alltrim(subs(memoline(mensagem,100,i),6) ) elseif subs(memoline(mensagem,100,i),1,8) = "Subject:" cSubject := alltrim(subs(memoline(mensagem,100,i),26) ) elseif subs(memoline(mensagem,100,i),1,5) = "Date:" cDate := alltrim(subs(memoline(mensagem,100,i),12) ) end if !empty(cFrom) .and. !empty(cSubject) .and. !empty(cDate) exit end next SELE CPRINBOX //dbf onde salva as msgs if Appb_dbf (0) // faz um append blank Replace CPRINBOX->datamsg with cDate,; CPRINBOX->remetente with cFrom,; CPRINBOX->assunto with cSubject,; CPRINBOX->data with date(),; CPRINBOX->texto with mensagem Lock_dbf (DB_FREE_TMP) else SndPlaySound( "OPS.wav",1 ) end end return nil

Gilmer, novamente o aviso do google: A página da web localizada em fivewin.com.br foi reportada como sendo maliciosa e bloqueada baseando-se nas suas configurações de segurança. []´s

Eu implantei a remessa para Itaú, Bradesco e Santander. Cada um é diferente do outro. Varia também conforme a carteira de cobrança do cliente. Perde-se um tempo tremendo. Tem que pegar os manuais de cada um e ir seguindo detalhadamente e combinar com o cliente os testes que devem ser combinados com o banco conforme o caso. []´s

Caros, desde ontem (11/08) quando tento acessar http://fivewin.com.br/index.php?/forum/12-programacao/ o firefox emite um alerta vermelho de Página Maliciosa: Clico ignorar e prossigo, já até preenchi o formulário https://www.google.com/safebrowsing/report_error/?tpl=mozilla&hl=pt-BR&url=http%3A%2F%2Ffivewin.com.br%2Findex.php mas ainda continua o aviso. Alguém mais está tendo esse aviso de bloqueio? []´s

Evaldo, uso assim no win10 normal: ACTION WinExec("CMD.EXE") Microsoft Windows [versão 10.0.14393] © 2016 Microsoft Corporation. Todos os direitos reservados. C:\WF\CP318> []´s

Caros, configurações por parte do usuário de servidores de e-mail é sempre complicada, principalmente que cada provedor utiliza seus próprios critérios. Então para evitar esses problemas, nós aqui sempre fizemos o seguinte: só habilitamos o programa a enviar e-mail para quem tiver o domínio hospedado conosco. Nós oferecemos serviço de hospedagem para clientes dos sistemas, então temos controle sobre todo o processo. Quem quiser usar os serviços de e-mail gratuitos não tem serviço de envio de email pelo programa. Quem quiser hospedar com outros também não. Dessa forma, além de nos facilitar o suporte, também agregamos um pequeno valor adicional nos ganhos. Hospedagem dá pouco retorno financeiro, mas na soma total ajuda a pagar a feira. Fica a dica: contrate um bom host de hospedagem, preferencialmente no EUA e passe a oferecer o serviço também. []´s

Beto, qual o erro que você teve quando tentou com a hospedagem do cliente? Configurou a porta smtp correta? Fiz testes com essa DLL e funcionou bem. Estou agora implementando no sistema.

Obrigado JM, vou tentar e retorno o resultado. []´s

Caros, nada disso funcionou. Eu já tinha tentado com o OurDbu, com o FiveDbu, atualizei agora o fivedbu, tentei com o DBFRecovery, com um programa meu que corta um trecho do arquivo e nada. Parece que o FPT bixou de tal jeito que não consegue ser lido. O FiveDbu e o OurDbu até travam. Paciência. Vou verificar os backups do usuário e retornar os arquivos de uns dias atrás. []´s

Caros, as vezes surge problema de corrupção em arquivos fpt (campo memo). Quando não tem conteúdo relevante, excluo o campo e crio novamente, zerando o arquivo fpt associado ao dbf. Agora me surgiu um caso de um usuário que não pode excluir o conteúdo dos memos. Já tentei copiar o dbf para novo arquivo (copy to...) não vai, tentei abrir com o OpenOffice, não abre. Alguém conhece algum macete ou ferramenta para recuperar o dito cujo? []´s

Você pode instalar uma máquina virtual com um windows 32 bits para continuar usando o Workshop, mas é melhor mudar para outro, por exemplo o Pelles.

Maravilha João! Você leu meus pensamentos... Estava precisando de uma solução assim para enviar e-mails. Estava usando a tsmtp mas ela tem alguns problemas e não sei porque não envia anexos com mais de 90 Kb. Testei agora essa sua dica e funcionou muito bem. Gracias!

Meus caros, nós trabalhamos oferecendo serviços na web desde de a internet começou a existir aqui no BR. Pela minha experiência, recomendo: fujam das empresas de hospedagem brasileiras. Já tentamos trabalhar em parceria com inúmeras empresas aqui e sempre tivemos problemas, sempre. Temos usado serviços nos EUA, pagamos em dólar, estamos sujeitos aos custos pela variação do dólar, mas em contrapartida os serviço deles são de primeira qualidade. Claro que tem os picaretas por lá também tem que pesquisar e procurar referências. Por vários anos usamos os serviços da http://www.azc.com/ , os serviços deles são excelentes mas os preços não são dos melhores. Atualmente, já há vários anos, utilizamos https://portal.eapps.com/aff.php?aff=471 e recomendo bastante. Custos são bons e o serviço de atendimento e suporte deles é muito bom. É claro que você precisa saber um mínimo de inglês quando precisar suporte, mas o tradutor do google resolve para quem não domina a língua e na nossa área o inglês básico é obrigatório. Essa é minha recomendação. []´s

Alessandro, em certas versões do FW tinha um bug na classe COMBOBOX que gerava um erro que nem lembro mais. Na época eu usava o FWH 8.04 Então nessa época eu juntava separadamente a classe corrigida, segue abaixo o prg dela. Hoje uso o FWH 14.01 e essa classe funciona bem. #include "FiveWin.ch" #include "Constant.ch" #define GWL_STYLE -16 #ifndef __CLIPPER__ #define COMBO_BASE 320 #else #define COMBO_BASE WM_USER #endif #define CB_ADDSTRING ( COMBO_BASE + 3 ) #define CB_DELETESTRING ( COMBO_BASE + 4 ) #define CB_GETCURSEL ( COMBO_BASE + 7 ) #define CB_INSERTSTRING ( COMBO_BASE + 10 ) #define CB_RESETCONTENT ( COMBO_BASE + 11 ) #define CB_FINDSTRING ( COMBO_BASE + 12 ) #define CB_SETCURSEL ( COMBO_BASE + 14 ) #define CB_SHOWDROPDOWN ( COMBO_BASE + 15 ) #define CB_GETDROPPEDSTATE ( COMBO_BASE + 23 ) #define CB_ERR -1 #define CB_SETMINVISIBLE 5889 // 0x1701 #define CB_GETMINVISIBLE 5890 // 0x1702 #define COLOR_WINDOW 5 #define COLOR_WINDOWTEXT 8 #define MB_ICONEXCLAMATION 48 // 0x0030 #define GW_CHILD 5 #define GW_HWNDNEXT 2 #ifdef __XPP__ #define Super ::TControl #define New _New #endif //----------------------------------------------------------------------------// CLASS TComboBox FROM TControl DATA aItems, aBitmaps DATA lOwnerDraw, nBmpHeight, nBmpWidth DATA nAt DATA bDrawItem, bCloseUp DATA cError AS String DATA oGet METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId,; bChange, bValid, nClrText, nClrBack, lPixel, oFont,; cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, nStyle,; cPict, bEChange ) CONSTRUCTOR METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ; bChange, nClrText, nClrBack, cMsg, lUpdate,; bWhen, acBitmaps, bDrawItem, nStyle, cPict, bEChange ) CONSTRUCTOR METHOD Add( cItem, nAt ) METHOD cToChar() INLINE Super:cToChar( "COMBOBOX" ) METHOD Change() METHOD CloseUp() INLINE If( ::bCloseUp != nil, Eval( ::bCloseUp, Self ),) METHOD Default() METHOD DefControl( oControl ) METHOD Del( nAt ) METHOD Destroy() METHOD End() INLINE ::Hide(), Super:End() METHOD DrawItem( nIdCtl, nPStruct ) METHOD FillMeasure( nPInfo ) INLINE LbxMeasure( nPInfo, ::nBmpHeight ) METHOD FindString( cItem, nFrom ) INLINE ; nFrom := If( nFrom == nil, 0, nFrom ),; ::SendMsg( CB_FINDSTRING, nFrom, cItem ) + 1 METHOD Find( cItem, nFrom ) INLINE ::FindString( cItem, nFrom ) != 0 #ifndef __CLIPPER__ METHOD GetMinVisible() INLINE If( IsAppThemed(), ; ::SendMsg( CB_GETMINVISIBLE, 0, 0 ), 0 ) #endif METHOD Initiate( hDlg ) METHOD Insert( cItem, nAt ) METHOD LostFocus() METHOD lValid() METHOD Modify( cItem, nAt ) METHOD MouseMove( nRow, nCol, nKeyFlags ) METHOD Open() INLINE ::SendMsg( CB_SHOWDROPDOWN, 1 ) METHOD Refresh() INLINE ::Set( Eval( ::bSetGet ) ), Super:Refresh() METHOD Reset() INLINE Eval( ::bSetGet,; If( ValType( Eval( ::bSetGet ) ) == "N", 0, "" ) ),; ::nAt := 0, ::SendMsg( CB_RESETCONTENT ),; ::Change() METHOD Select( nItem ) INLINE ::nAt := nItem,; ::SendMsg( CB_SETCURSEL, nItem - 1, 0 ) METHOD Set( cNewItem ) METHOD SetBitmaps( acBitmaps ) METHOD SetItems( aItems ) INLINE ::Reset(), ::aItems := aItems,; ::Default(), ::Change() // By default, 30 is the minimum number of visible items in XP Visual Themes #ifndef __CLIPPER__ METHOD SetMinVisible( nItems ) INLINE ; If( IsAppThemed(), ( ::SendMsg( CB_SETMINVISIBLE, nItems, 0 ) == 1 ), .f. ) #endif METHOD ShowToolTip() METHOD VarGet() METHOD State() INLINE ::SendMsg( CB_GETDROPPEDSTATE, 0 ) METHOD IsClosed() INLINE ::State() == 0 METHOD IsOpen() INLINE ::State() == 1 ENDCLASS //----------------------------------------------------------------------------// METHOD New( nRow, nCol, bSetGet, aItems, nWidth, nHeight, oWnd, nHelpId,; bChange, bValid, nClrFore, nClrBack, lPixel, oFont,; cMsg, lUpdate, bWhen, lDesign, acBitmaps, bDrawItem, nStyle,; cPict, bEChange ) CLASS TComboBox if nClrFore == nil nClrBack := GetSysColor( COLOR_WINDOW ) endif DEFAULT nRow := 0, nCol := 0, bSetGet := { || nil },; oWnd := GetWndDefault(),; oFont := oWnd:oFont,; aItems := {}, nWidth := 40, nHeight := 60,; nClrFore := GetSysColor( COLOR_WINDOWTEXT ),; lPixel := .f., lUpdate := .f., lDesign := .f.,; nStyle := CBS_DROPDOWNLIST ::cCaption = "" ::nTop = nRow * If( lPixel, 1, CMB_CHARPIX_H ) ::nLeft = nCol * If( lPixel, 1, CMB_CHARPIX_W ) ::nBottom = ::nTop + nHeight - 1 ::nRight = ::nLeft + nWidth - 1 ::nAt = 0 ::aItems = aItems ::bChange = bChange ::bSetGet = bSetGet ::oWnd = oWnd ::oFont = oFont if acBitmaps != nil ::SetBitmaps( acBitmaps ) else ::lOwnerDraw = .f. endif ::nStyle = nOR( If( nStyle == CBS_DROPDOWN, 0, LBS_NOTIFY ), WS_TABSTOP,; nStyle,; LBS_DISABLENOSCROLL, WS_CHILD, WS_VISIBLE, WS_BORDER,; WS_VSCROLL, If( lDesign, WS_CLIPSIBLINGS, 0 ),; If( ::lOwnerDraw, CBS_OWNERDRAWFIXED, 0 ) ) ::nId = ::GetNewId() ::nHelpId = nHelpId ::bValid = bValid ::lDrag = lDesign ::lCaptured = .f. ::cMsg = cMsg ::lUpdate = lUpdate ::bWhen = bWhen ::bDrawItem = bDrawItem ::SetColor( nClrFore, nClrBack ) if nStyle == CBS_DROPDOWN #ifdef __XPP__ #undef New #endif ::oGet := TGet():ReDefine( nil, ; // ID not used ::bSetGet, ; // bSETGET(uVar) Self, ; // oDlg ::nHelpID, ; // Help Context ID cPict, ; // Picture nil, ; // Valid is handled by the CBx ::nClrText,; ::nClrPane,; ::oFont, ; // <oFont> nil, ; // <oCursor> cMsg, ; // cMsg nil, ; // <.update.> nil, ; // <{uWhen}> bEChange, ; // {|nKey,nFlags,Self| <uEChange>} .F. ) // <.readonly.> ) endif if ! Empty( oWnd:hWnd ) ::Create( "COMBOBOX" ) ::Default() if oFont != nil ::SetFont( oFont ) endif oWnd:AddControl( Self ) else oWnd:DefControl( Self ) endif if ::oGet != nil ::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD ) ::oGet:Link() ::oGet:bLostFocus = ; {| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ; nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,; Eval( ::bSetGet, cItem ),; ::Select( nAt ),; SetWindowText( ::hWnd, cItem ),; If( ::bValid != nil .and. ; GetParent( hCtlFocus ) == GetParent( ::hWnd ),; If( ! Eval( ::bValid ),; PostMessage( ::hWnd, WM_SETFOCUS ),),) } endif if lDesign ::CheckDots() endif return Self //----------------------------------------------------------------------------// METHOD ReDefine( nId, bSetGet, aItems, oWnd, nHelpId, bValid, ; bChange, nClrFore, nClrBack, cMsg, lUpdate, ; bWhen, acBitmaps, bDrawItem, nStyle, cPict, ; bEChange ) CLASS TComboBox if nClrFore == nil nClrBack := GetSysColor( COLOR_WINDOW ) endif DEFAULT aItems := {},; nClrFore := GetSysColor( COLOR_WINDOWTEXT ),; lUpdate := .f., ; nStyle := CBS_DROPDOWNLIST ::nId = nId ::hWnd = 0 ::aItems = aItems ::bChange = bChange ::bSetGet = bSetGet ::oWnd = oWnd ::nHelpId = nHelpId ::bValid = bValid ::nAt = 0 ::lDrag = .f. ::lCaptured = .f. ::cMsg = cMsg ::lUpdate = lUpdate ::bWhen = bWhen ::bDrawItem = bDrawItem ::nStyle = nStyle if acBitmaps != nil ::SetBitmaps( acBitmaps ) else ::lOwnerDraw = .f. endif ::SetColor( nClrFore, nClrBack ) if lAnd( ::nStyle, CBS_DROPDOWN ) #ifdef __XPP__ #undef New #endif ::oGet := TGet():ReDefine( nil, ; // ID not used ::bSetGet, ; // bSETGET(uVar) Self, ; // oDlg ::nHelpID, ; // Help Context ID cPict, ; // Picture nil, ; // Valid is handled by the CBx ::nClrText,; ::nClrPane,; ::oFont, ; // <oFont> nil, ; // <oCursor> cMsg, ; // cMsg nil, ; // <.update.> nil, ; // <{uWhen}> bEChange, ; // {|nKey,nFlags,Self| <uEChange>} .F. ) // <.readonly.> ) endif oWnd:DefControl( Self ) return Self //----------------------------------------------------------------------------// METHOD Add( cItem, nAt ) CLASS TComboBox DEFAULT nAt := 0 if nAt == 0 AAdd( ::aItems, cItem ) else ASize( ::aItems, Len( ::aItems ) + 1 ) AIns( ::aItems, nAt ) ::aItems[ nAt ] = cItem endif ::SendMsg( CB_ADDSTRING, nAt, cItem ) return nil //----------------------------------------------------------------------------// METHOD Change() CLASS TComboBox local cItem := GetWindowText( ::hWnd ) // Current Value local nAt nAt = ::SendMsg( CB_GETCURSEL ) + 1 if nAt == ::nAt .and. ! Empty( Eval( ::bSetGet ) ) return nil endif ::nAt := nAt if ::nAt != 0 .and. ::nAt <= Len( ::aItems ) if ValType( Eval( ::bSetGet ) ) == "N" Eval( ::bSetGet, ::nAt ) else Eval( ::bSetGet, ::aItems[ ::nAt ] ) endif endif if ::oGet != nil // Always not nil for dropdown ::oGet:VarPut( Eval( ::bSetGet ) ) // udate variable before calling bChange ::oGet:Refresh() endif if ::bChange != nil Eval( ::bChange, Self, cItem ) endif return nil //----------------------------------------------------------------------------// METHOD DefControl( oControl ) CLASS TComboBox if ::aControls == nil ::aControls = {} endif AAdd( ::AControls, oControl ) return nil //----------------------------------------------------------------------------// METHOD Set( cNewItem ) CLASS TComboBox local nAt if ValType( cNewItem ) == "N" nAt = cNewItem if nAt == 0 nAt = 1 endif else nAt = AScan( ::aItems,; { | cItem | Upper( AllTrim( cItem ) ) == ; Upper( AllTrim( cNewItem ) ) } ) endif if ValType( cNewItem ) == "N" .or. nAt != 0 ::Select( nAt ) else cNewItem := cValToChar( cNewItem ) Eval( ::bSetGet, cNewItem ) SetWindowText( ::hWnd , cNewItem ) endif return nil //----------------------------------------------------------------------------// METHOD LostFocus() CLASS TComboBox local nAt := ::SendMsg( CB_GETCURSEL ) Super:LostFocus() if nAt != CB_ERR ::nAt = nAt + 1 if ValType( Eval( ::bSetGet ) ) == "N" Eval( ::bSetGet, nAt + 1 ) else Eval( ::bSetGet, ::aItems[ nAt + 1 ] ) endif else Eval( ::bSetGet, GetWindowText( ::hWnd ) ) endif return nil //----------------------------------------------------------------------------// METHOD Modify( cItem, nAt ) CLASS TComboBox DEFAULT nAt := 0 if nAt != 0 ::aItems[ nAt ] = cItem ::SendMsg( CB_DELETESTRING, nAt - 1 ) ::SendMsg( CB_INSERTSTRING, nAt - 1, cItem ) endif return nil //----------------------------------------------------------------------------// METHOD Insert( cItem, nAt ) CLASS TComboBox DEFAULT nAt := 0 if nAt != 0 ASize( ::aItems, Len( ::aItems ) + 1 ) AIns( ::aItems, nAt ) ::aItems[ nAt ] = cItem ::SendMsg( CB_INSERTSTRING, nAt - 1, cItem ) endif return nil //----------------------------------------------------------------------------// METHOD Del( nAt ) CLASS TComboBox DEFAULT nAt := 0 if nAt != 0 ADel( ::aItems, nAt ) ASize( ::aItems, Len( ::aItems ) - 1 ) ::SendMsg( CB_DELETESTRING, nAt - 1 ) endif return nil //----------------------------------------------------------------------------// METHOD Initiate( hDlg ) CLASS TComboBox Super:Initiate( hDlg ) ::Default() if ::oGet != nil ::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD ) ::oGet:Link() ::oGet:bLostFocus = ; {| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ; nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,; Eval( ::bSetGet, cItem ),; ::Select( nAt ),; SetWindowText( ::hWnd, cItem ),; If( ::bValid != nil .and. ; GetParent( hCtlFocus ) == GetParent( ::hWnd ),; If( ! Eval( ::bValid ),; PostMessage( ::hWnd, WM_SETFOCUS ),),) } endif ::Refresh() return nil //----------------------------------------------------------------------------// METHOD Default() CLASS TComboBox local cStart := Eval( ::bSetGet ) if ! Empty( ::hWnd ) .and. ::nStyle == CBS_DROPDOWNLIST ::nStyle := GetWindowLong( ::hWnd, GWL_STYLE ) endif if cStart == nil Eval( ::bSetGet, If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) ) cStart = If( Len( ::aItems ) > 0, ::aItems[ 1 ], "" ) endif AEval( ::aItems, { | cItem, nAt | ::SendMsg( CB_ADDSTRING, nAt, cItem ) } ) if ValType( cStart ) != "N" ::nAt = AScan( ::aItems, { | cItem | Upper( AllTrim( cItem ) ) == ; Upper( AllTrim( cStart ) ) } ) else ::nAt = cStart endif ::nAt = If( ::nAt > 0, ::nAt, 1 ) if cStart == nil ::Select( ::nAt ) else ::Set( cStart ) endif /* if ::oGet != nil ::oGet:hWnd = GetWindow( ::hWnd, GW_CHILD ) ::oGet:Link( .t. ) ::oGet:bLostFocus = ; {| hCtlFocus, nAt, cItem| cItem := GetWindowText( ::hWnd ), ; nAt := ::SendMsg( CB_FINDSTRING, 0, Trim( cItem )) + 1,; Eval( ::bSetGet, cItem ),; ::Select( nAt ),; SetWindowText( ::hWnd, cItem ),; If( ::bValid != nil .and. ; GetParent( hCtlFocus ) == GetParent( ::hWnd ),; If( ! Eval( ::bValid ),; PostMessage( ::hWnd, WM_SETFOCUS ),),) } endif */ return nil //----------------------------------------------------------------------------// METHOD MouseMove( nRow, nCol, nKeyFlags ) CLASS TComboBox local nResult := Super:MouseMove( nRow, nCol, nKeyFlags ) return If( ::lDrag, nResult, nil ) // We want standard behavior !!! //----------------------------------------------------------------------------// METHOD SetBitmaps( acBitmaps ) CLASS TComboBox local n ::lOwnerDraw = .t. if acBitmaps != nil ::aBitmaps = Array( Len( acBitmaps ) ) for n = 1 to Len( acBitmaps ) if File( acBitmaps[ n ] ) ::aBitmaps[ n ] = ReadBitmap( 0, acBitmaps[ n ] ) else ::aBitmaps[ n ] = LoadBitmap( GetResources(), acBitmaps[ n ] ) endif next ::nBmpHeight = nBmpHeight( ::aBitmaps[ 1 ] ) ::nBmpWidth = nBmpWidth( ::aBitmaps[ 1 ] ) endif return nil //----------------------------------------------------------------------------// METHOD Destroy() CLASS TComboBox local n if ::aBitmaps != nil for n = 1 to Len( ::aBitmaps ) DeleteObject( ::aBitmaps[ n ] ) next endif if ::oGet != nil ::oGet:Destroy() endif return Super:Destroy() //----------------------------------------------------------------------------// METHOD DrawItem( nIdCtl, nPStruct ) CLASS TComboBox return LbxDrawItem( nPStruct, ::aBitmaps, ::aItems, ::nBmpWidth, ::bDrawItem ) //----------------------------------------------------------------------------// METHOD VarGet() CLASS TComboBox local cRet, nAt := ::SendMsg( CB_GETCURSEL ) if nAt != CB_ERR ::nAt = nAt + 1 cRet := ::aItems[ nAt + 1 ] else cRet := GetWindowText( ::hWnd ) endif return cRet //----------------------------------------------------------------------------// METHOD lValid() CLASS TComboBox local lRet := .t. if ValType( ::bValid ) == "B" lRet = Eval( ::bValid, ::oGet ) endif return lRet //----------------------------------------------------------------------------// METHOD ShowToolTip() CLASS TComboBox local nOldBottom nOldBottom = ::nBottom ::nBottom = ::nTop + GetTextHeight( ::hWnd ) + 8 Super:ShowToolTip() ::nBottom = nOldBottom return nil //----------------------------------------------------------------------------//

Valdir estou usando o manual do MySQL 5, é bem detalhado, muito bom. http://dev.mysql.com/doc/refman/5.1/en/ Em brasileiro só achei da versão 4.1 http://downloads.mysql.com/docs/refman-4.1-pt.a4.pdf []´s