Jump to content
Fivewin Brasil

Ariston Santos

Membros
 View Profile  See their activity

  • Posts

    500

  • Joined

  • Last visited

  • Days Won

    11

 Content Type 

Everything posted by Ariston Santos

  1. Ariston Santos
    Costumo ouvir pessoas dizer: "Nem sei como agradecer". Eu sei sim: MUUUUUUUITO OBRIGADO !!!!!!!!!!!!!
  2. Ariston Santos
    Algumas dúvidas: 1 - De que se trata o inventário? Seria o estoque da farmácia no banco de dados do SNGPC? 2 - Os medicamentos e insumos movimentados (enviados) são incluídos e baixados do inventário? 3 - Quais as limitações ou requisitos para envio de inventários?
  3. Ariston Santos
    William, Muito obrigado por toda a ajuda. Vou iniciar a programação usando teus exemplos. Qualquer dúvida ou barreira que surgir, posto aqui.
  4. Ariston Santos
    Obrigado aos que já ajudaram. Alguém pode postar como montam dos demais XMLs?
  5. Ariston Santos
    Olá pessoal. Preciso gerar e transmitir os XMLs ao Webservice do SNGPC mas não tenho nada. Já notei em alguns tópicos aqui que tem alguns colegas que já desenvolveram esse tipo de solução. Gostaria de saber se podem compartilhar aqui algum código que possa me ajudar a iniciar esse projeto. Grato.
  6. Ariston Santos
    Tenho uma rotina para criar cartões de senha com código no formato EAN13. A senha fica embutida no código (conforme já sugerido acima). A lógica é: • Uso apenas números na senha (sem letras); • Gero o código de barras no formato de ITEM IN STORE (padrão de balanças pesadoras). Ex: 2SSSSSSRRRRRX onde 2=Indicador de Item In Store, S=Senha ocupando 6 posições, com zeros à esquerda, R=Número aleatório (randômico) só para confundir e X=Dígito verificador. • Ao ler o código de barras, extraio a senha contida nas posições 2 a 7 do código e removo os zeros à esquerda. A senha ainda fica visível mas dessa forma dificulta a ação dos mal-intencionados, além do fato de que o código EAN13 é melhor para ler até por leitores de baixa qualidade.
  7. Ariston Santos
    * Atualmente está assim a minha função para mostrar a rota entre dois endereços. STATIC FUNCTION Show_Way(End_Clie, Nmr_Clie, Cid_Clie, Est_Clie) If !IsInternet() Msgalert("não conectado a internet.", "Aviso!") ; Return nil Endif cOrigem := Alltrim(mEnd)+", "+Alltrim(mNmr)+", "+Alltrim(c_Emun)+", "+Alltrim(c_EUF) cDestino := Alltrim(End_Clie)+", "+Alltrim(Nmr_Clie)+", "+Alltrim(Cid_Clie)+", "+ALLTRIM(Est_Clie) Ferase(CurDrive()+":\"+CurDir()+"\tempgmapdist.html") // uRegPath:= "c:\test" cHtml := MemoRead(CurDrive()+":\"+CurDir()+"\modelos\rotanet.html") cHtml := StrTran( cHtml, "<<ORIGEM>>", cOrigem) cHtml := StrTran( cHtml, "<<DESTINO>>", cDestino) IF FileWrite(CurDrive()+":\"+CurDir()+"\tempgmapdist.html", cHtml ) WAITRUN( GetEnv( "ComSpec" )+" /C START "+CurDrive()+":\"+CurDir()+"\tempgmapdist.html", 0 ) ENDIF RETURN NIL Conteúdo do HTML <html><head><title>Mapa com rota</title> <script type='text/javascript' src='http://maps.google.com/maps/api/js?v=3.1&sensor=false&language=pt-BR'></script> <script type='text/javascript'> var map, geocoder; var mapDisplay, directionsService; function initialize() { var myOptions = {zoom: 15,mapTypeId: google.maps.MapTypeId.ROADMAP}; map = new google.maps.Map(document.getElementById('map_canvas'), myOptions); geocoder = new google.maps.Geocoder(); var enderDe = "ORIGEM"; var enderAte = "DESTINO"; geocoder.geocode( { 'address': enderAte, 'region' : 'BR'},trataLocs); initializeDirections (); calcRota (enderDe, enderAte); } function initializeDirections () { directionsService = new google.maps.DirectionsService(); mapDisplay = new google.maps.DirectionsRenderer(); mapDisplay.setMap(map); mapDisplay.setPanel(document.getElementById("panel")) } function calcRota(endDe, endPara) { var request = { origin:endDe, destination:endPara, travelMode: google.maps.DirectionsTravelMode.DRIVING }; directionsService.route(request, function(response, status) { if (status == google.maps.DirectionsStatus.OK) { mapDisplay.setDirections(response) } }) } function trataLocs (results, status) { var elem = document.getElementById('msg'); if (status == google.maps.GeocoderStatus.OK) { map.setCenter(results[0].geometry.location); var marker = new google.maps.Marker({ map: map, position: results[0].geometry.location }); if (results.length > 1) { var i, txt = '<select style="font-family:Verdana;font-size:8pt;width=550px;" onchange="mostraEnd(this.options[this.selectedIndex].text);">'; elem.innerHTML = 'O endereço exato não foi localizado - há ' + results.length.toString() + ' resultados aproximados.<br />'; for (i = 0; i < results.length; i++) { txt = txt + '<option value="' + i.toString() + '"'; if (i == 0) { txt = txt + ' selected="selected"'; txt = txt + '>' + results[i].formatted_address + '</option>'; } } txt = txt + '</select>' elem.innerHTML = elem.innerHTML + txt; } } else elem.innerHTML = 'Erro no tratamento do endereço :<br /><b>' + status + '</b>'; } </script> </head> <body onload='initialize();' style='font-family:Verdana;font-size:8pt;margin:5px 0 5px 0;'> <center> <div id='map_canvas' style='width:800px;height:450px'></div> <div id='panel' style='width:550px;height:450px'></div> </center> </html> Não tenho outra, apenas esta.
  8. Ariston Santos
    Será que não funciona assim? TRY *... Seus comandos MYSQL CATCH oErr MsgAlert("Ocorreu um erro ao tentar executar o comando."+CRLF+CRLF+; "Favor verificar as configurações de banco de dados.","Erro") MemoWrit(".\errorlog\erro.txt", oErr:Description) *WAITRUN( GetEnv( "ComSpec" )+" /C NOTEPAD .\errorlog\erro.txt", 0) *PostQuitMessage( 0 ) *__QUIT() END
  9. Ariston Santos
    Obrigado, amigo. Vou testar e aviso se encontrar qualquer dificuldade.
  10. Ariston Santos
    Olá. Alguém tem código para importar arquivos TDM (de ECFs), que possa compartilhar? Desde já, agradeço.
  11. Ariston Santos
    Os demais colegas devem ter exemplos mais completos mas este mostra como eu cadastro e modifico fornecedores usando SQLRDD. /****************************************************************************** * Nome do PRG: fornenet.prg (Iniciada em 24/05/2014) * * Função.....: Cadastro e alteração de fornecedores via sqlrdd * * Autor......: Ariston Santos (Pode contar código de colaboradores) * * Site.......: www.arsoft-ap.com.br * * Suporte....: www.arsoft-ap.com.br/index.php#four * ******************************************************************************/ #include "FiveWin.ch" #include "corget.ch" #include "image.ch" #include "sqlrdd.ch" #include "msg.ch" #include "xbrowse.ch" #include "vlib.ch" STATIC aForns FUNCTION CadFornec(oDlg) oDlg:cMsg := "Obtendo a lista dos dados cadastrados..." oDlg:Refresh() l_Err := .F. aForns := PegaFornecs(2) oDlg:cMsg := "Aguarde um momento..." oDlg:Refresh() cDesc := SPACE(40) cCodi := SPACE(13) cFant := SPACE(40) DEFINE DIALOG oDlItm FROM 0, 0 TO 35, 100 TITLE "Cadastro de fornecedores" //Procurar campo 1 @02,005 SAY "Descrição - Asterisco (*) para TODOS" OF oDlItm SIZE 100,10 PIXEL @10,005 GET cDesc OF oDlItm SIZE 100,10 PIXEL UPDATE WHEN .F. //Procurar campo 2 @02,110 SAY "Código" OF oDlItm SIZE 50,10 PIXEL @10,110 GET cCodi PICTURE "9999999999999" OF oDlItm SIZE 50,10 PIXEL UPDATE WHEN .F. //Procurar campo 3 @02,170 SAY "Fantasia" OF oDlItm SIZE 100,10 PIXEL @10,170 GET cFant OF oDlItm SIZE 100,10 PIXEL UPDATE WHEN .F. @25,05 XBROWSE oBrw ; COLUMNS 1,2,3,4,5,6,7,8 ; HEADERS "Código", "Razão social", "Fantasia", "Contato", "Telefone", "Endereço", "Cidade", "UF" ; COLSIZES 90,200,200,150,150,200,100,25; OF oDlItm ; ARRAY aForns ; ON DBLCLICK EditFornec(.f., oBrw) ; SIZE 385, 210 PIXEL LINES CELL UPDATE oBrw:bClrSelFocus := {|| { CLR_WHITE, CLR_HBLUE }} // Seleção com foco oBrw:bClrSel := {|| { CLR_BLACK, CLR_GRAY }} // Seleção sem foco oBrw:lColDividerComplete := .f. oBrw:CreateFromCode() nLin := 20*12 nCol := 55 @ nLin, (8+(nCol*1)-55) SBUTTON oSbt1 PROMPT "&Cadastrar" OF oDlItm ACTION EditFornec(.t., oBrw) SIZE 50, 18 PIXEL FILENAME ".\FIGURAS\Novo.BMP" COLORS CLR_BLACK,{CLR_HGRAY,CLR_WHITE,3} NOBORDER XP TOOLTIP "Cadastrar novo fornecedor" @ nLin, (8+(nCol*2)-55) SBUTTON oSbt2 PROMPT "&Alterer" OF oDlItm ACTION EditFornec(.f., oBrw) SIZE 50, 18 PIXEL FILENAME ".\FIGURAS\abrir.BMP" COLORS CLR_BLACK,{CLR_HGRAY,CLR_WHITE,3} NOBORDER XP WHEN LEN(aForns) > 0 TOOLTIP "Modificar dados do fornecedor" @ nLin, (8+(nCol*3)-55) SBUTTON oSbt3 PROMPT "&Excluir" OF oDlItm ACTION DeleFornec(oBrw) SIZE 50, 18 PIXEL FILENAME ".\FIGURAS\lixeira.bmp" COLORS CLR_BLACK,{CLR_HGRAY,CLR_WHITE,3} NOBORDER XP WHEN LEN(aForns) > 0 TOOLTIP "Excluir o fornecedor" @ nLin, (8+(nCol*4)-55) SBUTTON oSbt3 PROMPT "&Imprimir" OF oDlItm ACTION ImprFornec(aForns) SIZE 50, 18 PIXEL FILENAME ".\FIGURAS\printer.BMP" COLORS CLR_BLACK,{CLR_HGRAY,CLR_WHITE,3} NOBORDER XP WHEN LEN(aForns) > 0 TOOLTIP "Imprimir listagem dos fornecedores" @ nLin, (8+(nCol*7)-55) SBUTTON oSbt7 PROMPT "&Retornar" OF oDlItm ACTION oDlItm:End() SIZE 50, 18 PIXEL FILENAME ".\FIGURAS\STOP.BMP" COLORS CLR_BLACK,{CLR_HGRAY,CLR_WHITE,3} NOBORDER XP TOOLTIP "Retornar à tela principal" ACTIVATE DIALOG oDlItm CENTERED RETURN NIL FUNCTION PegaFornecs(nOrd) LOCAL l_Err := .f., aArray := {}, SqlArr n_Conn := nConection() IF n_Conn != 0 SqlArr := "SELECT CODIGO,"+; // 1 - Código " ITEM02,"+; // 2 - Razao social " ITEM10,"+; // 3 - Fantasia " ITEM03,"+; // 4 - Contato " ITEM04,"+; // 5 - Fone " ITEM07,"+; // 6 - Endereço / Logradouro " ITEM05,"+; // 7 - Cidade " ITEM06,"+; // 8 - UF " ITEM35,"+; // 9 - Número do imóvel " ITEM08" +; //10 - CNPJ " FROM forneced_bd" aArray := SQLArray(LOWER(SqlArr), @l_Err) IF LEN(aArray) > 0 ASORT(aArray,,,{|A,B| A[nOrd] < B[nOrd]}) ENDIF ENDIF RETURN(aArray) *----------------( Cadastro / Alteração do fornecedor )------------------------) STATIC FUNCTION EditFornec(lAppnd, oBrw) LOCAL lSave := .F., nQue := 1, nAt := oBrw:nArrayAt LOCAL nFcodi := 0 ,; // Código cItm02 := SPACE(50) ,; // Razao social cItm03 := SPACE(30) ,; // Contato cItm04 := SPACE(15) ,; // Fone 1 cItm05 := SPACE(30) ,; // Cidade cItm06 := SPACE(02) ,; // UF cItm07 := SPACE(45) ,; // Endereço / Logradouro cItm08 := SPACE(20) ,; // CNPJ cItm09 := SPACE(15) ,; // IE cItm10 := SPACE(50) ,; // Fantasia cItm11 := SPACE(15) ,; // FAX cItm12 := SPACE(40) ,; // E-mail cItm13 := SPACE(40) ,; // Site cItm14 := SPACE(30) ,; // Bairro cItm15 := SPACE(10) ,; // CEP cItm16 := SPACE(15) ,; // Fone 2 cItm17 := SPACE(15) ,; // Celular dItm18 := DATE() ,; // Data cadastro lItm19 := .F. ,; // Aceita devolu‡Æo? lItm20 := .F. ,; // É fabricante? cItm21 := SPACE(03) ,; // Frete CIF ou FOB? cItm22 := SPACE(20) ,; // Banco 1 cItm23 := SPACE(20) ,; // Agencia 1 cItm24 := SPACE(20) ,; // N§ conta 1 cItm25 := SPACE(20) ,; // Obs banco 1 cItm26 := SPACE(20) ,; // Banco 2 cItm27 := SPACE(20) ,; // Agencia 2 cItm28 := SPACE(20) ,; // N§ conta 2 cItm29 := SPACE(20) ,; // Obs banco 2 cItm30 := SPACE(20) ,; // Banco 3 cItm31 := SPACE(20) ,; // Agencia 3 cItm32 := SPACE(20) ,; // N§ conta 3 cItm33 := SPACE(20) ,; // Obs banco 3 cItm34 := SPACE(35) ,; // País do fornecedor / Transportadora cItm35 := SPACE(10) ,; // Número do imóvel cItm36 := SPACE(09) ,; // Número de inscrição do participante na Suframa. cItm37 := SPACE(10) // Pessoa: FÍSICA, JURÍDICA IF lAppnd MsgRun("Conectando...","Conectando...",{||n_Conn := nConection()}) IF n_Conn == 0 ; RETURN NIL ; ENDIF SqlArr := "SELECT MAX(CODIGO) AS ULTCOD FROM forneced_bd" aMaxIt := SQLArray(SqlArr) IF LEN(aMaxIt) > 0 nFcodi := aMaxIt[1,1] + 1 ENDIF ELSE a_Field := {} SqlArr := "SELECT CODIGO,"+; // 01 - Código " ITEM02,"+; // 02 - Razao social " ITEM03,"+; // 03 - Contato " ITEM04,"+; // 04 - Fone 1 " ITEM05,"+; // 05 - Cidade " ITEM06,"+; // 06 - UF " ITEM07,"+; // 07 - Endereço / Logradouro " ITEM08,"+; // 08 - CNPJ " ITEM09,"+; // 09 - IE " ITEM10,"+; // 10 - Fantasia " ITEM11,"+; // 11 - FAX " ITEM12,"+; // 12 - E-mail " ITEM13,"+; // 13 - Site " ITEM14,"+; // 14 - Bairro " ITEM15,"+; // 15 - CEP " ITEM16,"+; // 16 - Fone 2 " ITEM17,"+; // 17 - Celular " ITEM18,"+; // 18 - Data cadastro " ITEM19,"+; // 19 - Aceita devolu‡Æo? " ITEM20,"+; // 20 - É fabricante? " ITEM21,"+; // 21 - Frete CIF ou FOB? " ITEM22,"+; // 22 - Banco 1 " ITEM23,"+; // 23 - Agencia 1 " ITEM24,"+; // 24 - N§ conta 1 " ITEM25,"+; // 25 - Obs banco 1 " ITEM26,"+; // 26 - Banco 2 " ITEM27,"+; // 27 - Agencia 2 " ITEM28,"+; // 28 - N§ conta 2 " ITEM29,"+; // 29 - Obs banco 2 " ITEM30,"+; // 30 - Banco 3 " ITEM31,"+; // 31 - Agencia 3 " ITEM32,"+; // 32 - N§ conta 3 " ITEM33,"+; // 33 - Obs banco 3 " ITEM34,"+; // 34 - País do fornecedor / Transportadora " ITEM35,"+; // 35 - Número do imóvel " ITEM36,"+; // 36 - Número de inscrição do participante na Suframa. " ITEM37" +; // 37 - Pessoa: FÍSICA, JURÍDICA " FROM forneced_bd WHERE CODIGO = "+ALLTRIM(STR(aForns[nAt,1])) l_Err := .F. a_Field := SQLArray(SqlArr, @l_Err) IF LEN(a_Field) == 0 .OR. l_Err == .T. SysRefresh() MsgAlert("Fornecedor não mais encontrado no banco de dados.", "Aviso") RETURN NIL ENDIF nFcodi := aForns[nAt,1] cItm02 := a_Field[1,02] cItm03 := a_Field[1,03] cItm04 := a_Field[1,04] cItm05 := a_Field[1,05] cItm06 := a_Field[1,06] cItm07 := a_Field[1,07] cItm08 := a_Field[1,08] cItm09 := a_Field[1,09] cItm10 := a_Field[1,10] cItm11 := a_Field[1,11] cItm12 := a_Field[1,12] cItm13 := a_Field[1,13] cItm14 := a_Field[1,14] cItm15 := a_Field[1,15] cItm16 := a_Field[1,16] cItm17 := a_Field[1,17] dItm18 := a_Field[1,18] lItm19 := a_Field[1,19] lItm20 := a_Field[1,20] cItm21 := a_Field[1,21] cItm22 := a_Field[1,22] cItm23 := a_Field[1,23] cItm24 := a_Field[1,24] cItm25 := a_Field[1,25] cItm26 := a_Field[1,26] cItm27 := a_Field[1,27] cItm28 := a_Field[1,28] cItm29 := a_Field[1,29] cItm30 := a_Field[1,30] cItm31 := a_Field[1,31] cItm32 := a_Field[1,32] cItm33 := a_Field[1,33] cItm34 := a_Field[1,34] cItm35 := a_Field[1,35] cItm36 := a_Field[1,36] cItm37 := a_Field[1,37] ENDIF cAviso := "" IF nQue = 1 cAviso := "Os dados indicados com asterísco (*) são obrigatórios para geração do SPED" ENDIF DEFINE FONT oSayFnt NAME "Times New Roman" SIZE 0, -30 BOLD ITALIC DEFINE DIALOG F_dl RESOURCE "FORN_CAD" TITLE IIF(lAppnd ,"Cadastro","Alteração") REDEFINE SAY oId25 PROMPT "Ficha Cadastral - "+{"Fornecedor","Transportadora","Laboratórios"}[nQue] ID 58 OF F_dl COLORS CLR_HBLUE oId25:SetFont(oSayFnt) REDEFINE GET oId33 VAR nFcodi PICTURE "9999999999" ID 33 OF F_dl WHEN .F. REDEFINE GET oId34 VAR cItm02 ID 34 OF F_dl VALID EVAL({||(IIF(EMPTY(cItm02),MsgStop("Este campo nao pode ficar vazio!","Êpa!"),nil)),!EMPTY(cItm02)}) REDEFINE GET oId35 VAR cItm10 ID 35 OF F_dl VALID EVAL({||(IIF(EMPTY(cItm10),MsgStop("Este campo nao pode ficar vazio!","Êpa!"),nil)),!EMPTY(cItm10)}) REDEFINE GET oId36 VAR cItm03 ID 36 OF F_dl REDEFINE GET oId37 VAR cItm05 ID 37 OF F_dl REDEFINE GET oId38 VAR cItm06 ID 38 OF F_dl // VALID CheckMunUF(@cAviso, cItm05, cItm06, oId68) REDEFINE GET oId41 VAR cItm15 ID 41 OF F_dl REDEFINE GET oId51 VAR cItm07 ID 51 OF F_dl REDEFINE GET oId66 VAR cItm35 ID 66 OF F_dl REDEFINE GET oId52 VAR cItm14 ID 52 OF F_dl REDEFINE GET oId67 VAR cItm34 ID 67 OF F_dl REDEFINE GET oId39 VAR cItm04 ID 39 OF F_dl REDEFINE GET oId40 VAR cItm16 ID 40 OF F_dl REDEFINE GET oId42 VAR cItm11 ID 42 OF F_dl REDEFINE GET oId32 VAR cItm17 ID 32 OF F_dl REDEFINE COMBOBOX oCt70 VAR cItm37 ITEMS {"FÍSICA", "JURÍDICA"} ID 70 OF F_dl REDEFINE GET oId48 VAR cItm08 ID 48 OF F_dl // VALID CheckCpf(cItm08, lAppnd, 2) REDEFINE GET oId49 VAR cItm09 ID 49 OF F_dl REDEFINE GET oId69 VAR cItm36 PICTURE "999999999" ID 69 OF F_dl REDEFINE GET oId43 VAR cItm12 ID 43 OF F_dl REDEFINE GET oId56 VAR cItm13 ID 56 OF F_dl REDEFINE GET oId46 VAR dItm18 ID 46 OF F_dl REDEFINE COMBOBOX oId44 VAR cItm21 ITEMS {"CIF","FOB"} ID 44 OF F_dl REDEFINE CHECKBOX oId45 VAR lItm19 ID 45 OF F_dl WHEN nQue = 1 REDEFINE CHECKBOX oId47 VAR lItm20 ID 47 OF F_dl WHEN nQue = 1 REDEFINE GET oId50 VAR cItm22 ID 50 OF F_dl REDEFINE GET oId53 VAR cItm23 ID 53 OF F_dl REDEFINE GET oId54 VAR cItm24 ID 54 OF F_dl REDEFINE GET oId55 VAR cItm25 ID 55 OF F_dl REDEFINE GET oId57 VAR cItm26 ID 57 OF F_dl REDEFINE GET oId59 VAR cItm27 ID 59 OF F_dl REDEFINE GET oId60 VAR cItm28 ID 60 OF F_dl REDEFINE GET oId61 VAR cItm29 ID 61 OF F_dl REDEFINE GET oId62 VAR cItm30 ID 62 OF F_dl REDEFINE GET oId63 VAR cItm31 ID 63 OF F_dl REDEFINE GET oId64 VAR cItm32 ID 64 OF F_dl REDEFINE GET oId65 VAR cItm33 ID 65 OF F_dl REDEFINE BUTTON oBt1 ID 30 OF F_dl ACTION ( lSave := .T. , F_dl:End()) REDEFINE BUTTON oBt2 ID 31 OF F_dl ACTION ( lSave := .F. , F_dl:End()) REDEFINE SAY oId68 PROMPT cAviso ID 68 OF F_dl COLORS CLR_HRED ACTIVATE DIALOG F_dl CENTERED ON INIT (IIF(nQue != 1,(oId45:Hide(),oId47:Hide()),NIL)) if lSave IF lAppnd cQury := "INSERT INTO forneced_bd (CODIGO, ITEM02, ITEM03, ITEM04, ITEM05, ITEM06, ITEM07, ITEM08, ITEM09, ITEM10, ITEM11, ITEM12, ITEM13, ITEM14, ITEM15, ITEM16, ITEM17, ITEM18, ITEM19, ITEM20, ITEM21, ITEM22, ITEM23, ITEM24, ITEM25, ITEM26, ITEM27, ITEM28, ITEM29, ITEM30, ITEM31, ITEM32, ITEM33, ITEM34, ITEM35, ITEM36, ITEM37) VALUES "+CRLF cQury += "("+ALLTRIM(STR(nFcodi))+", '"+; cItm02+"', '"+; cItm03+"', '"+; cItm04+"', '"+; cItm05+"', '"+; cItm06+"', '"+; cItm07+"', '"+; cItm08+"', '"+; cItm09+"', '"+; cItm10+"', '"+; cItm11+"', '"+; cItm12+"', '"+; cItm13+"', '"+; cItm14+"', '"+; cItm15+"', '"+; cItm16+"', '"+; cItm17+"', '"+; SR_Val2Char(dItm18)+"', '"+; IIF(lItm19,"1","0")+"', '"+; IIF(lItm20,"1","0")+"', '"+; cItm21+"', '"+; cItm22+"', '"+; cItm23+"', '"+; cItm24+"', '"+; cItm25+"', '"+; cItm26+"', '"+; cItm27+"', '"+; cItm28+"', '"+; cItm29+"', '"+; cItm30+"', '"+; cItm31+"', '"+; cItm32+"', '"+; cItm33+"', '"+; cItm34+"', '"+; cItm35+"', '"+; cItm36+"', '"+; cItm37+"')" TRY MsgRun("Conectando...","Conectando...",{||n_Conn := nConection()}) IF n_Conn == 0 ; BREAK ; ENDIF oSql := SR_GetConnection() nErr := oSql:Execute(cQury) oSql:Commit() // Atualiza o browse aForns := PegaFornecs(1) oBrw:SetArray(aForns) oBrw:bLogicLen := {|| len(aForns)} oBrw:GoBottom() oBrw:Refresh() CATCH oErr SysRefresh() MsgErro("Erro ao tentar salvar os dados."+CRLF+CRLF+; "Erro: "+oErr:Description,"Erro") END ELSE cQury := "UPDATE forneced_bd SET"+; " ITEM02 = '"+cItm02+"'," + ; " ITEM03 = '"+cItm03+"'," + ; " ITEM04 = '"+cItm04+"'," + ; " ITEM05 = '"+cItm05+"'," + ; " ITEM06 = '"+cItm06+"'," + ; " ITEM07 = '"+cItm07+"'," + ; " ITEM08 = '"+cItm08+"'," + ; " ITEM09 = '"+cItm09+"'," + ; " ITEM10 = '"+cItm10+"'," + ; " ITEM11 = '"+cItm11+"'," + ; " ITEM12 = '"+cItm12+"'," + ; " ITEM13 = '"+cItm13+"'," + ; " ITEM14 = '"+cItm14+"'," + ; " ITEM15 = '"+cItm15+"'," + ; " ITEM16 = '"+cItm16+"'," + ; " ITEM17 = '"+cItm17+"'," + ; " ITEM18 = '"+SR_Val2Char(dItm18)+"'," + ; " ITEM19 = '"+IIF(lItm19,"1","0")+"'," + ; " ITEM20 = '"+IIF(lItm20,"1","0")+"'," + ; " ITEM21 = '"+cItm21+"'," + ; " ITEM22 = '"+cItm22+"'," + ; " ITEM23 = '"+cItm23+"'," + ; " ITEM24 = '"+cItm24+"'," + ; " ITEM25 = '"+cItm25+"'," + ; " ITEM26 = '"+cItm26+"'," + ; " ITEM27 = '"+cItm27+"'," + ; " ITEM28 = '"+cItm28+"'," + ; " ITEM29 = '"+cItm29+"'," + ; " ITEM30 = '"+cItm30+"'," + ; " ITEM31 = '"+cItm31+"'," + ; " ITEM32 = '"+cItm32+"'," + ; " ITEM33 = '"+cItm33+"'," + ; " ITEM34 = '"+cItm34+"'," + ; " ITEM35 = '"+cItm35+"'," + ; " ITEM36 = '"+cItm36+"'," + ; " ITEM37 = '"+cItm37+"'" + ; " WHERE CODIGO = "+ALLTRIM(STR(aForns[nAt,1])) lSaved := .F. TRY MsgRun("Conectando...","Conectando...",{||n_Conn := nConection()}) IF n_Conn == 0 ; BREAK ; ENDIF oSql := SR_GetConnection() nErr := oSql:Execute(cQury) oSql:Commit() lSaved := .T. CATCH oErr SysRefresh() MsgErro("Erro ao tentar salvar os dados."+CRLF+CRLF+; "Erro: "+oErr:Description,"Erro") END IF lSaved aForns[nAt, 2] := cItm02 aForns[nAt, 3] := cItm10 aForns[nAt, 4] := cItm03 aForns[nAt, 5] := cItm04 aForns[nAt, 6] := cItm07 aForns[nAt, 7] := cItm05 aForns[nAt, 8] := cItm06 oBrw:Refresh() ENDIF endif endif RETURN NIL *----------------( Exclusão do fornecedor )------------------------------------) STATIC FUNCTION DeleFornec(oBrw) LOCAL nAt := oBrw:nArrayAt, cQury IF ! MsgNoYes("Você está prestes a excluir este fornecedor:"+CRLF+CRLF+; "CÓDIGO: "+ALLTRIM(STR(aForns[nAt, 1]))+CRLF+; "CNPJ: "+ALLTRIM(aForns[nAt, 10])+CRLF+; "NOME: "+ALLTRIM(aForns[nAt, 2]), "Confirma a exclusão?") RETURN NIL ENDIF cQury := "DELETE FROM forneced_bd WHERE CODIGO = '"+ALLTRIM(STR(aForns[nAt,1]))+"'" TRY MsgRun("Excluindo...","Aguarde...",{||n_Conn := nConection()}) IF n_Conn == 0 ; BREAK ; ENDIF oSql := SR_GetConnection() nErr := oSql:Execute(cQury) oSql:Commit() // Atualiza o browse aForns := PegaFornecs(2) oBrw:SetArray(aForns) oBrw:bLogicLen := {|| len(aForns)} oBrw:GoTop() oBrw:Refresh() CATCH oErr SysRefresh() MsgErro("Erro ao tentar excluir o fornecedor."+CRLF+CRLF+; "Erro: "+oErr:Description,"Erro") END RETURN NIL *----------------( Impressão da listagem de fornecedores )---------------------) STATIC FUNCTION ImprFornec(aForns) PRINTER oPrn NAME "Fornecedores" PREVIEW oPrn:SetLandscape() DEFINE FONT oFont NAME "Courier New" SIZE 0, -8 OF oPrn DEFINE FONT oFon2 NAME "Arial" SIZE 0, -08 OF oPrn BOLD DEFINE FONT oFon3 NAME "Arial Narrow" SIZE 0, -11 OF oPrn BOLD DEFINE FONT oFon4 NAME "Arial Narrow" SIZE 0, -08 OF oPrn DEFINE PEN oPen COLOR CLR_BLACK WIDTH (oFont:nHeight/10) DEFINE PEN oLin COLOR CLR_HGRAY WIDTH (oFont:nHeight/12) mLarg := oFon2:nHeight nTab := (oPrn:nHorzRes() / 22) * 2 nSpc := (oPrn:nHorzRes()- (2*nTab)) / 120 nCls := {nTab+(nSpc*000),; nTab+(nSpc*006),; nTab+(nSpc*019),; nTab+(nSpc*050),; nTab+(nSpc*092),; nTab+(nSpc*119) } // Cabeçalho nRow := 3 nPag := 1 nTtl := 0 oPrn:StartPage() oPrn:Box(03*mLarg, nTab, 08*mLarg, oPrn:nHorzRes()-nTab, oPen ) oPrn:SayBitmap((3.5 * mLarg ), nTab+nSpc, ".\figuras\logoimpr.bmp", 20*nSpc, 4*mLarg) nRow := 4 oPrn:Say(nRow*mLarg, oPrn:nHorzRes()-(nTab+nSpc), "DATA "+DTOC(DATE()), oFont,,,,1) nRow++ oPrn:Say(nRow*mLarg, oPrn:nHorzRes()/2, "AUTOBOX LUBRIFICANTES", oFon3,,,,2) oPrn:Say(nRow*mLarg, oPrn:nHorzRes()-(nTab+nSpc), "HORA "+LEFT(TIME(),5), oFont,,,,1) nRow++ oPrn:Say(nRow*mLarg, oPrn:nHorzRes()-(nTab+nSpc), "PAGINA "+ALLTRIM(STR(nPag)), oFont,,,,1) nRow += 2.5 oPrn:Say(nRow*mLarg, oPrn:nHorzRes()/2, "LISTAGEM DE FORNECEDORES", oFon3, , , , 2) nRow+= 1.5 oPrn:Line(nRow*mLarg,nTab, nRow*mLarg,oPrn:nHorzRes()-nTab, oPen ) nRow += 0.5 // Título oPrn:Say(nRow*mLarg, nCls[01], "CÓDIGO", oFont) oPrn:Say(nRow*mLarg, nCls[02], "CNPJ", oFont) oPrn:Say(nRow*mLarg, nCls[03], "NOME", oFont) oPrn:Say(nRow*mLarg, nCls[04], "ENDEREÇO", oFont) oPrn:Say(nRow*mLarg, nCls[05], "CIDADE", oFont) oPrn:Say(nRow*mLarg, nCls[06], "TELEFONE", oFont,,,,1) nRow+=2 FOR nLin := 1 TO LEN(aForns) oPrn:Say(nRow*mLarg, nCls[01], STRZERO(aForns[nLin,1],5), oFon4) oPrn:Say(nRow*mLarg, nCls[02], aForns[nLin,10], oFon4) oPrn:Say(nRow*mLarg, nCls[03], ALLTRIM(aForns[nLin,2]), oFon4) oPrn:Say(nRow*mLarg, nCls[04], ALLTRIM(aForns[nLin,6])+", "+ALLTRIM(aForns[nLin,9]), oFon4) oPrn:Say(nRow*mLarg, nCls[05], ALLTRIM(aForns[nLin,7])+"-"+ALLTRIM(aForns[nLin,8]), oFon4) oPrn:Say(nRow*mLarg, nCls[06], ALLTRIM(aForns[nLin,5]), oFon4,,,,1) nRow += 1.2 oPrn:Line(nRow*mLarg,nTab, nRow*mLarg,oPrn:nHorzRes()-nTab, oLin ) nRow += 0.2 IF (nRow*mLarg) >= ( oPrn:nVertRes()-(8*mLarg) ) oPrn:EndPage() oPrn:StartPage() // Cabeçalho nRow := 3 nPag ++ oPrn:Say(nRow*mLarg, nTab, "DATA "+DTOC(DATE())+" às "+LEFT(TIME(),5)+"h", oFon2) oPrn:Say(nRow*mLarg, oPrn:nHorzRes()/2, "LISTAGEM DE FORNECEDORES", oFon3, , , , 2) oPrn:Say(nRow*mLarg, oPrn:nHorzRes()-((1.5*nTab)+nSpc), "PAGINA "+ALLTRIM(STR(nPag)), oFon2,,,,1) nRow+= 1.5 // Título nRow++ oPrn:Say(nRow*mLarg, nCls[01], "CÓDIGO", oFont) oPrn:Say(nRow*mLarg, nCls[02], "CNPJ", oFont) oPrn:Say(nRow*mLarg, nCls[03], "NOME", oFont) oPrn:Say(nRow*mLarg, nCls[04], "ENDEREÇO", oFont) oPrn:Say(nRow*mLarg, nCls[05], "CIDADE", oFont) oPrn:Say(nRow*mLarg, nCls[06], "TELEFONE", oFont,,,,1) nRow+=2 oPrn:Line(nRow*mLarg,nTab, nRow*mLarg,oPrn:nHorzRes()-nTab, oPen ) nRow += 0.5 ENDIF NEXT oPrn:EndPage() oPrn:Preview() DeleteObject(oPrn) RELEASE FONT oFont, oFon2, oFon3, oFon4 RETURN NIL Funções adicionais requeridas FUNCTION nConection() LOCAL a_Array, nErr, nPos, cComm STORE 0 TO nErr, nPos a_Array := {} TRY oSql := SR_GetCnn() // Retorna um objeto da conexão derivado da classe SR_CONNECTION caso a conexão esteja ativa oSql:exec( "SHOW TABLES",,.t.,@a_Array,,,0) // Executar qualquer comando, apenas para testar a conexão. CATCH oErr // Se houve erro, a conexão foi perdida. SR_End() // Fecha todas as conexões n_Conn := 0 IF SetConnection() // Abre nova conexão n_Conn := SR_GetActiveConnection() // Obtem o ID da conexão ativa SR_UseDeleteds(.F.) // Don't keep deleted records in database SR_SetFastOpen(.T.) // ABRE AS TABELAS EM MODO COMPARTILHADO SR_SetGoTopOnScope(.F.) // NÃO EXECUTA O DBGOTOP() AUTOMATICO NOS ORDSCOPE SR_MaxRowCache( 100 ) // Determina o tamanho máximo teórico do cache de linhas da workarea SR_SetBaseLang( 2 ) // portugues SR_Msg(2) // portugues SR_SETSYNTHETICINDEX(.F.) // Força que os próximos índices criados sejam sintéticos(porem os indice ficam por conta apenas do SQLRDD) SR_SETSYNTHETICINDEXMINIMUN(10) //Configura a quantidade mínima de colunas na chave de índice para criá-lo como Sintético ENDIF END RETURN( n_Conn ) FUNCTION SetConnection() LOCAL _Wait, lConn cRDD := "SQLRDD" cDSN := "MYSQL" lConn := Connect(@cRDD, cDSN) IF ! lConn *SysRefresh() ; MsgAlert("Não foi possível estabelecer uma conaxão com o servidor de banco de dados. Favor tentar novamente","Aviso") ENDIF RETURN(lConn) FUNCTION SQLArray(c_Sql, l_Err) LOCAL a_Array, nErr, nPos STORE 0 TO nErr, nPos l_Err := .F. a_Array := {} SQL := c_Sql TRY oSql := SR_GetConnection() apCode := SR_SQLParse( SQL, @nErr, @nPos ) SQL := SR_SQLCodeGen( apCode, { 1000 }, oSql:nSystemID ) nErr := oSql:Exec( SQL,,.t.,@a_Array) CATCH oErr l_Err := .T. n:=1 cFile := GetCurDir()+"\errorlog\Err_"+StrZero(n,4)+".Log" while File(cFile) n++ cFile := GetCurDir()+"\errorlog\Err_"+StrZero(n,4)+".Log" end FileWrite(cFile, oErr:Description) SysRefresh() MsgAlert("Erro ao tentar obter os dados."+CRLF+CRLF+; "Erro: "+oErr:Description+CRLF+CRLF+; "Favor reconectar e tentar novamente.","Erro") END RETURN( a_Array ) Espero que ajude.
  12. Ariston Santos
    http://www.byjg.com.br/site/ também fornece algumas mensagens grátis para teste.
  13. Ariston Santos
    Segue: //----------------------------------------------------------------------------------------------------------------------// DLL Function DeleteUrlCacheEntry(lpszUrlName AS STRING) AS LONG PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll" //----------------------------------------------------------------------------------------------------------------------// A DLL fica em c:\Windows\System32\wininet.dll
  14. Ariston Santos
    Ótima dica. Comigo só funcionou assim: #include "tip.ch" FUNCTION RetPublicIP() LOCAL cPubIP := "", cxHtml := "" url := "http://checkip.dyndns.org" try oUrl:=TUrl():New( url ) // From tip.lib oHttp := TipClientHttp():New( oUrl , .f. ) // From tip.lib catch oErr ? "Erro: "+oErr:Description end try Try oHttp:Open() cxHtml := oHttp:ReadAll() // Baixa todo o conteúdo do site. cPubIP := allTrim( substr( substr( cxHtml, rat( "<body>", cxHtml ) + 26 ), 1, At( "<", substr( cxHtml, rat( "<body>", cxHtml ) + 26 ) ) - 1 ) ) catch oErr ? "Erro: "+oErr:Description End oHttp:Close() DeleteUrlCacheEntry(url) // Lipar Cache ? cPubIP Return Nil
  15. Ariston Santos
    Deixa eu ver aqui como está meu porquinho, se quebrando, dá pra atualizar minha relíquia - FWH 12,06 (KKK)
  16. Ariston Santos
    Até onde sei, o & no WorkShop e Fivewin, se colado junto ao caractere seguinte, o transforma em tecla de atalho (para Alt + Tecla). Assim, &D indica Alt+D. Se você não quer isso, experimente colocar um espaço - D & D (D+espaço+&+espaço+D).
  17. Ariston Santos
    Enviado para teu email.
  18. Ariston Santos
    A partir de hoje entra em vigor a validação do CEST, amigo.
  19. Ariston Santos
    Uma vez denunciaram meu site só porque eu coloquei um programa craqueado para download. De repente começou a aparecer a mesma mensagem. A solução foi eu mudar o conteúdo do site para outra pasta. Na pasta da página inicial deixei um index.php só com o comando para redirecionar para o index.php da nova pasta (exemplo abaixo). Com isso, parou de aparecer a mensagem vermelha. <?php header("Location: http://www.meusite.com.br/novapasta/index.php") ; ?>
  20. Ariston Santos
    Tenho exemplo para leitor de marca diferente. Serve? Se tiver o SDK, dá para programar esse aí. Deve ser a mesma ideia. Exemplo: Ptit01 := TestSDK() FUNCTION TestSDK() local aFiles := Array( ADir( CurDrive()+":\"+GetCurDir()+"\DIGITAL\D*.TXT" ) ) local ADir := ADir( CurDrive()+":\"+GetCurDir()+"\DIGITAL\D*.TXT", aFiles ) IF cFReader != "Fingkey Hamster - Nitgen" MsgAlert("Configure a biometria no menu 'Configurações' -> 'Gerais'","Erro de configuração") RETURN " " ENDIF TRY objNBioBSP := CreateObject('NBioBSPCOM.NBioBSP') objDevice := objNBioBSP:Device objExtraction := objNBioBSP:Extraction objMatching := objNBioBSP:Matching objExtraction:WindowStyle := 0; objDevice:Open(255) objExtraction:DefaultTimeout := SECS("02:00:00") * 1000 // Duas horas convertidas para milliseconds objExtraction:Capture() cTempl := objExtraction:TextEncodeFIR() cDedo := "" IF LEN(aFiles) > 0 FOR nDedo := 1 TO LEN(aFiles) cTxtFile := CurDrive()+":\"+GetCurDir()+"\DIGITAL\"+aFiles[nDedo] objMatching:VerifyMatch(cTempl, MEMOREAD(cTxtFile)) if objMatching:ErrorCode <> 0 *msginfo("error") else if objMatching:MatchingResult = 1 cDedo := aFiles[nDedo] EXIT endif endif NEXT ENDIF cCodigo := "0" IF ! EMPTY(cTempl) SELECT 3 // Pessoal PESSOAL->(DBSETORDER(1)) nRec := SUBSTR(cDedo,5,4) cCodigo := "0" IF ! PESSOAL->(DBSEEK(VAL(nRec))) PESSOAL->(DBGOTOP()) ELSE cCodigo := ALLTRIM(STR(PESSOAL->CODIGO)) ENDIF ELSE cCodigo := " " ENDIF objDevice:Close(255) CATCH MsgAlert( "ERRO! O leitor biométrico não está instalado em seu computador.", "Aviso") cCodigo := " " END RETURN( cCodigo )
  21. Ariston Santos
    Muito bom. Embora o fladimir tenha razão uma função dessas ainda é útil. Tiro por mim. Mesmo com todas a validações ainda tem operador que deixa de preencher campos necessários no cadastro do cliente ou do produto. Além disso, não dá para obrigar o preenchimento de tudo pois nem todos os clientes emitem NF-e ou NFC-e, e não necessitam preencher vários campos. Em sistemas flexíveis à várias situações, uma função dessas é uma ótima solução. Vou testar.
  22. Ariston Santos
    Ótimo. Finalmente um bom motivo para eu atualizar meu FWH1206 :D
  23. Ariston Santos
    Com MsgLogo eu não consegui por isso criei minha própria função: MsgSobre(nLong) FUNCTION MsgSobre(nSecs) local oBmp, oDlg DEFAULT nSecs := 0 DEFINE BITMAP oBmp RESOURCE "IMSOBRE" // Sua imagem no recurso DEFINE BRUSH oBru RESOURCE "IMSOBRE"// Sua imagem no recurso DEFINE DIALOG oDlg FROM 0, 0 TO 20, 75 TITLE "Sobre o MEUPROG (Versão: ??????)" oDlg:lHelpIcon := .f. SET BRUSH OF oDlg TO oBru IF nSecs > 0 ACTIVATE DIALOG oDlg ON INIT ( oDlg:SetSize( oBmp:nWidth + 6, oBmp:nHeight + 22 ) , oDlg:CENTER) NOWAIT SysWait(nSecs) oDlg:End() ELSE ACTIVATE DIALOG oDlg ON INIT ( oDlg:SetSize( oBmp:nWidth + 6, oBmp:nHeight + 22 ) , oDlg:CENTER) ENDIF oBmp:End() oBru:End() RETURN NIL Exemplos de uso: MsgSobre() // Espera fechar manualmente MsgSobre(nil)// Espera fechar manualmente MsgSobre(2) // Espera dois segundos MsgSobre(nSecs) // Espera nSecs segundos
  24. Ariston Santos
    Dorneles, eu faço da mesma forma que você e também estou tendo o mesmo problema. No final do rateio, quando há diferença, estou tendo que eliminar a diferença manualmente. A forma que o Alessandro (Aferra) mostrou seria a solução mas esse tipo de rateio não está sendo proporcional; alguns itens podem ficar com desconto muito alto e outros com desconto muito baixo. A dica do microfly se aplica à parcelas de venda a prazo e não a rateio de desconto. Também faço isso com venda sem problemas mas com rateio de desconto não funciona porque temos de levar em conta a quantidade de itens. Só funcionaria se eu sempre vendesse apenas um item (assim como cada parcela é apenas uma parcela). Resumindo: Também estou tentando desenvolver essa solução. Quando eu conseguir, disponibilizo. Quem conseguir uma funcional primeiro, por favor, compartilhe.
  25. Ariston Santos
    Não sei se funciona, mas você pode tentar assim: • Criar um a tabela temporária com a nova estrutura; • Dar um INSERT INTO tabela_temp (Campo1, Campo2, ...) SELECT Campo1, Campo2, ... FROM tabela_atual • Dar um DROP TABLE na tabela atual • Dar um ALTER TABLE tabela_temp RENAME tabela_atual Este é o método que uso atualmente para modificar estrutura de tabelas, mas ainda não testei com tabelas com grande quantidade de arquivos. Também ainda não testei em ambiente multi-usuário. Segue o código que uso, para você ter uma ideia. Eu uso a SQLRDD. Criação de uma tabela: // Criação da tabela de itens por revendedora: gas_itens aEstr:={} AADD( aEstr ,{ "cnpjid", "C", 14, 0 } ) // Revendedor: CNPJ da disk gás/água AADD( aEstr ,{ "itemid", "C", 13, 0 } ) // Item: Código pessoal - pode ser o código de barras do cliente. AADD( aEstr ,{ "itdesc", "C", 50, 0 } ) // Item: Descrição AADD( aEstr ,{ "itprun", "N", 10, 2 } ) // Item: Valor unitário AADD( aEstr ,{ "ittaxa", "N", 10, 2 } ) // Item: Taxa de entrega AADD( aEstr ,{ "itfoto", "M", 10, 0 } ) // Item: Imagem do item AADD( aEstr ,{ "itmobs", "C",100, 0 } ) // Item: Observação IF ! SR_ExistTable( "gas_itens" ) TRY cComm := XB2SqlStr(aEstr, "gas_itens") nErr := oSql:Execute( cComm ) CATCH oErr MsgAlert("Erro ao tentar conectar com o banco de dados."+CRLF+; "Favor verificar sua conexão e tente novamente."+CRLF+CRLF+; "Erro: "+oErr:Description, "Ocorreu um erro") FileWrite(ErroFile(), oErr:Description) PostQuitMessage( 0 ) __QUIT() END else lChg := ChkStruct("gas_itens", "", aEstr, oSql, nErr, nPos) ENDIF A função XB2SqlStr() STATIC FUNCTION XB2SqlStr(aStr, cDBase) LOCAL cStrct cStrct := "CREATE TABLE `"+LOWER(cDBase)+"` (" FOR nF := 1 TO LEN(aStr) IF LOWER(aStr[nF,1]) != "sr_recno" IF nF > 1 ; cStrct += ", " ; ENDIF // Mais de um campo cStrct += "`"+LOWER(aStr[nF,1])+"` "+SetFType(aStr[nF,2],aStr[nF,3],aStr[nF,4]) ENDIF NEXT IF LEN(aStr) > 0 ; cStrct += ", " ; ENDIF // Já acrescentado algum campo cStrct += "`sr_recno` BIGINT (15) NOT NULL UNIQUE AUTO_INCREMENT)" // Sempre criar o 'sr_recno' no final, para compatibilizar com SQLRDD RETURN( cStrct ) STATIC FUNCTION SetFType(cTipo,nSize,nDeci) LOCAL cFType IF cTipo = "C" ; cFType := "char("+ALLTRIM(STR(nSize))+")" ELSEIF cTipo = "M" ; cFType := "mediumblob" ELSEIF cTipo = "N" ; cFType := "double("+ALLTRIM(STR(nSize))+","+ALLTRIM(STR(nDeci))+")" ELSEIF cTipo = "L" ; cFType := "tinyint(4)" ELSEIF cTipo = "D" ; cFType := "date" ENDIF RETURN(cFType) A função que faz a modificação na estrutura, se necessário: ChkStruct() STATIC FUNCTION ChkStruct(cTable, cUniq, aStrct, oSql, nErr, nPos) LOCAL lChangd, cComm, aNewStr, aOldStr, aChange, aImport, cImport, aArray := {}, cTmpTable := cTable+"_old" aNewStr := aStrct nScan := ASCAN(aNewStr, {|nC|nC[1]="sr_recno"}) IF nScan = 0 AADD(aNewStr, {"sr_recno", "N", 15, 0}) // SQLRDD acrescenta este campo ao criar a tabela ENDIF cSay := "Verificando a tabela '"+cTable+"'" oSay:SetText(cSay) oSay:Refresh() IF ! l_Check ; RETURN .F.; ENDIF // Obter a estrutura da tabela atual. nErr := 0 TRY cComm := "SELECT * FROM "+cTable+" LIMIT 1" nErr := oSql:Execute( cComm ) oSql:iniFields(.f.) aOldStr := oSql:aFields // Para pegar a estrutura CATCH ShowMsgTray("Não foi possível testar a tabela '"+cTable+"'", "Aguarde...") ; SysWait(1) RETURN .F. END TRY // Comparar com a estrutura de aStrct lChangd := .F. aChange := {} aImport := {} cImport := "" TRY FOR nX := 1 TO LEN(aNewStr) // Verifica se foi acrescentado algum campo ou se mudou o tamanho de algum. cFild:=Lower(aNewStr[nX,1]) cType:=aNewStr[nX,2] cSize:=STRZERO(aNewStr[nX,3], 4) cDeci:=STRZERO(aNewStr[nX,4], 3) nElem := ASCAN(aOldStr, {|aNro| Lower(aNro[1]) == cFild}) IF nElem > 0 if cFild != "sr_recno" // Não considerar erro de estrutura deste IF cType != aOldStr[nElem,2] .OR. ; cSize != STRZERO(aOldStr[nElem,3], 4) .OR. ; cDeci != STRZERO(aOldStr[nElem,4], 3) lChangd := .T. // Mudou o tamanho de um campo aadd(aChange, {cFild, "Modificou a estrutura"}) ENDIF endif ELSE lChangd := .T. // Foi removido algum campo aadd(aChange, {cFild, "Campo acrescentado"}) ENDIF NEXT FOR nX := 1 TO LEN(aOldStr) // Verifica se foi excluindo algum compo cFild := Lower(aOldStr[nX,1]) nElem := ASCAN(aNewStr, {|aNro| Lower(aNro[1]) == cFild}) IF nElem = 0 lChangd := .T. // Algum campo foi removido aadd(aChange, {cFild, "Campo removido"}) ELSE AADD(aImport, cFild) // Para pegar só os campos que existem nas duas tabelas. ENDIF NEXT IF lChangd // Determinar quais campos serão importados da tabela temporária FOR nX := 1 TO LEN(aImport) IF Lower(aImport[nX]) != "sr_recno" // Apenas um teste IF ! EMPTY(cImport) ; cImport += ", " ; ENDIF cImport += Lower(aImport[nX]) // Pegar só os campos que existem nas duas tabelas. ENDIF NEXT ENDIF CATCH ShowMsgTray("Não foi possível testar a tabela '"+cTable+"'", "Aguarde...") SysWait(0.5) RETURN .F. END TRY IF SR_ExistTable( cTmpTable ) cComm := "DROP TABLE "+cTmpTable TRY nErr := oSql:Execute( cComm ) if nErr == 0 ShowMsgTray("Executou "+cComm, "Ok") ; SysWait(0.5) else ShowMsgTray("Não foi preciso executar "+cComm, "Aguarde...") ; SysWait(2) endif CATCH ShowMsgTray("Não foi possível excluir a tabela '"+cTmpTable+"'", "Erro...") SysWait(0.5) RETURN .F. END TRY ENDIF IF ! lChangd ShowMsgTray("Extrutura de '"+cTable+"' sem alterações.", "Ok") ; SysWait(0.5) RETURN .F. ENDIF // Ver se tem itens na tabela oSql:Exec("SELECT * FROM "+cTable,,.t.,@aArray,,,0) cComm := "ALTER TABLE "+cTable+" RENAME "+cTmpTable nErr := oSql:Execute( cComm ) if nErr == 0 ShowMsgTray("Executou "+cComm, "Ok") ; SysWait(0.5) else ShowMsgTray("Não foi possível executar "+cComm, "Aguarde...") ; SysWait(2) RETURN .F. endif l_Err := .F. TRY cComm := XB2SqlStr(aStrct, cTable) nErr := oSql:Execute( cComm ) ShowMsgTray("Criou "+cTable, "Ok") ; SysWait(0.5) CATCH oErr FileWrite(ErroFile(), oErr:Description) l_Err := .T. END TRY IF l_Err cComm := "ALTER TABLE "+cTmpTable+" RENAME "+cTable nErr := oSql:Execute( cComm ) ShowMsgTray("Erro ao tentar criar a nova a tabela: Executado RollBack '"+cTable+"'.","Erro") ; SysWait(1) RETURN .F. ENDIF IF ! EMPTY(cUniq) TRY cSql := "ALTER TABLE "+cTable+" ADD UNIQUE ("+cUniq+")" nErr := oSql:Execute(cSql) ShowMsgTray("Executada query "+cSql,"Retorno: "+cValToChar(nErr)) ; SysWait(1) CATCH END TRY ENDIF // Importar dados da tabela temporária IF LEN(aArray) > 0 TRY cQury := "INSERT INTO "+cTable+" ("+cImport+") SELECT "+cImport+" FROM "+cTmpTable BEGIN TRANSACTION nErr := oSql:Execute(cQury) END TRANSACTION oSql:Commit() ShowMsgTray("Executou "+cComm, "Ok") ; SysWait(0.5) CATCH oErr MsgAlert("Erro ao tentar conectar com o banco de dados."+CRLF+; "Favor verificar sua conexão e tente novamente."+CRLF+CRLF+; "Erro: "+oErr:Description, "Ocorreu um erro") FileWrite(ErroFile(), oErr:Description) END TRY ENDIF // Excluir a tabela temporária cComm := "DROP TABLE "+cTmpTable nErr := oSql:Execute( cComm ) if nErr == 0 ShowMsgTray("Executou "+cComm, "Ok") ; SysWait(0.5) else ShowMsgTray("Não foi preciso executar "+cComm, "Aguarde...") ; SysWait(2) endif RETURN( .t. )
×
×
  • Create New...