Jump to content
Fivewin Brasil

Ariston Santos

Membros
  • Posts

    500
  • Joined

  • Last visited

  • Days Won

    11

Posts posted by Ariston Santos

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

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

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

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

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

  6. Segue:

    //----------------------------------------------------------------------------------------------------------------------//
    DLL Function DeleteUrlCacheEntry(lpszUrlName AS STRING) AS LONG PASCAL FROM "DeleteUrlCacheEntryA" LIB "wininet.dll"
    //----------------------------------------------------------------------------------------------------------------------//

    A DLL fica em c:\Windows\System32\wininet.dll

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

     

  8. 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") ;
    ?>
    
  9. 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 )
    
  10. 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.

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

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

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