Clipper On Line • Ver Tópico - Formulário de Pedido Digital

Formulário de Pedido Digital

Discussão sobre interface com o Cliente.

Moderador: Moderadores

 

Formulário de Pedido Digital

Mensagempor rochinha » 04 Set 2018 04:14

Amiguinhos,

hazael
Segue exemplo para você iniciar sua jornada.

Parte do código em .ASP(pedidos.asp) para a gravação de um arquivo texto com campos separados por "|"(pipe)
<%@LANGUAGE = VBScript%>
<%
  Dim PathArquivo
  PathArquivo = Server.MapPath("\")
  LogArquivo  = "\pedidos.txt"
  Set fs=CreateObject("Scripting.FileSystemObject")
  if not fs.FileExists( PathArquivo & LogArquivo ) then
     fs.CreateTextFile( PathArquivo & LogArquivo )
  end if
  Set ArquivoLog  = fs.OpenTextFile(PathArquivo & LogArquivo,8,False,False)
  LinhaDados =              Request.QueryString("txtNome") + " | "
  LinhaDados = LinhaDados + Request.QueryString("txtEmail") + " | "
  LinhaDados = LinhaDados + Request.QueryString("txtTelefone") + " | "
  LinhaDados = LinhaDados + Request.QueryString("txtCodigo") + " | "
  LinhaDados = LinhaDados + Request.QueryString("txtDescricao") + " | "
  LinhaDados = LinhaDados + Request.QueryString("txtQuantidade") + " | "
  LinhaDados = LinhaDados + Request.QueryString("txtMensagem") + " | "
  ArquivoLog.Write(Date())
  ArquivoLog.Write(" | ")
  ArquivoLog.Write(Time())
  ArquivoLog.Write(" | ")
  ArquivoLog.WriteLine(LinhaDados)
  ArquivoLog.Close
  Set ArquivoLog  = Nothing
  Set PathArquivo = Nothing
%>
<font face="Arial" size="2">
      <center>
           <br>Pedido cadastrado com sucesso.<br><br>
           <a href="javascript:history.go(-1)"><b>Clique aqui</b></a> para voltar<br><br>
           <strong>Hazael Desenvolvimento<br>Solu&ccedil;&otilde;es em Tecnologia, Sistemas e Automa&ccedil;&atilde;o.</strong></font>
           <font size="1" face="Verdana, Arial, Helvetica, sans-serif"><br>
                 Rua da Sua Casa, 123<br>
                 Centro - SP - 01234-567<br>
                 (11) 2143-5432 / (11) 5423-2143
           </font>
      </center>
</font>


Parte do form para pegar os dados que serão enviados para o script de gravação:
<form action="pedidos.asp" id="contact-form" method="post">
   <fieldset>
        <label><span class="text-form">Seu Nome:</span><input name="txtNome" type="text" /></label>
        <label><span class="text-form">Seu E-mail:</span><input name="txtEmail" type="text" /></label>
...
Outros campos
...
        <div class="wrapper">
         <div class="text-form">Sua Mensagem:</div>
         <div class="extra-wrap">
            <textarea name="txtMensagem"></textarea>
            <div class="clear"></div>
            <div class="buttons">
               <a class="button" href="#" onClick="document.getElementById('contact-form').reset()">Limpa</a>
               <a class="button" href="#" onClick="document.getElementById('contact-form').submit()">Envia</a>
            </div>
         </div>
        </div>
   </fieldset>
</form>


Caso deseje usar .PHP modifique e implemente o código abaixo:
<?php
//PEGA OS DADOS ENVIADOS PELO FORMULÁRIO
$txtClienteCodigo = $_GET["txtCliente"];
$txtProdutoCodigo = $_GET["txtCodigo"];
$txtProdutoQuantidade = $_GET["txtQuantidade"];

//
$arquivo = "pedidos.txt";
$caminho = "./";
//

$file = fopen($caminho . $arquivo, 'a+');
fwrite($file, date('d/m/y') . "|" . $txtClienteCodigo . "|" . $txtProdutoCodigo . "|" . $txtProdutoQuantidade . "\r\n" );
fclose($file);

echo $usererro;
?>
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Formulário de Pedido Digital

Mensagempor rochinha » 06 Set 2018 21:44

Amiguinhos,

hazael
Os códigos que encontrei tem datas antigas, DBF2ASP.PRG-14/08/2013, DBF2FUNC.PRG-25/09/2011 e DBF2RC-19/09/2004.

Analise e implemente caso queira.
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Formulário de Pedido Digital

Mensagempor rochinha » 06 Set 2018 21:45

DBF2ASP.PRG
#include "fivewin.ch"

function main( cFile,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10 )

    p1  := iif(p1=NIL,"",p1)
    p2  := iif(p2=NIL,"",p2)
    p3  := iif(p3=NIL,"",p3)
    p4  := iif(p4=NIL,"",p4)
    p5  := iif(p5=NIL,"",p5)
    p6  := iif(p6=NIL,"",p6)
    p7  := iif(p7=NIL,"",p7)
    p8  := iif(p8=NIL,"",p8)
    p9  := iif(p9=NIL,"",p9)
    p10 := iif(p10=NIL,"",p10)
    ? 'MAKEhtm 1.0 Direiros Reservados 1999-2000 Soft Clever Informatica ME.'
    if cFile = NIL
       ? 'Uso    :  MAKEhtm <NomeDohtm> [op‡”es] '
       ? ' '
       ? 'Exemplo:  MAKEhtm <NomeDohtm> /m/n'
       QUIT
    endif
    ? ' '
    //numprg={}
    //numprg=Adir("*.dbf")
    numopt=p1+p2+p3+p4+p5+p6+p7+p8+p9+p10
    //declare prg_files[numprg]
    //Adir("*.dbf",prg_files)
    //Asort(prg_files)
    //
    // -> Arquivo temporario
iprg_files = 1
//do while .t.

    prg_name := cFile
    //prg_name := alltrim(substr(prg_files[iprg_files],1,at(".",prg_files[iprg_files])-1))
    ? 'Criando... '+prg_name
    use (prg_name)
    copy structure extend to temp
    use
    use temp
    go top

    cFile := alltrim(prg_name) + ".HTM"
    ret_line := "chr(13)+chr(10)"

    errhandle = fcreate(cFile)
    fwrite(errhandle,[<html>]+&ret_line.)
    fwrite(errhandle,[<body bgcolor="#FFFFFF">]+&ret_line.)
    fwrite(errhandle,[<table border=0 cellpadding=0 cellspacing=0 valign="top"  align="center" width="70%">]+&ret_line.)
    fwrite(errhandle,[       <table width="100%" border="0" cellspacing="0" cellpadding="0">]+&ret_line.)
    fwrite(errhandle,[              <tr>]+&ret_line.)
    fwrite(errhandle,[                 <td colspan="2" bgcolor="#FFFFFF" valign="center" align="center">]+&ret_line.)
    fwrite(errhandle,[                     <!-- START FORM HERE -->]+&ret_line.)
    fwrite(errhandle,[                     <form name="frm]+NewCapFirst(prg_name)+[" action="]+prg_name+[.asp" method="POST" onSubmit="">]+&ret_line.)
    fwrite(errhandle,[                            <input type="hidden" name="acao"   value="inclusao">]+&ret_line.)
    fwrite(errhandle,[                            <!-- BLOCO DE MANUTENCAO -->]+&ret_line.)
    fwrite(errhandle,[                            <input type="hidden" name="origem" value="IP">]+&ret_line.)
    fwrite(errhandle,[                            <!-- BR -->]+&ret_line.)
    fwrite(errhandle,[                            <!-- p align="center" -->]+&ret_line.)
    fwrite(errhandle,[                            <table border="0" cellpadding="2" cellspacing="1" width="600" bgcolor="#FFFFFF">]+&ret_line.)
    fwrite(errhandle,[                                   <tr bgcolor="#386898" align="center">]+&ret_line.)
    fwrite(errhandle,[                                       <td colspan="2">]+&ret_line.)
    fwrite(errhandle,[                                           <b>]+&ret_line.)
    fwrite(errhandle,[                                           <font color="#FFFFFF" size="4" face="Arial, Helvetica, sans-serif">]+&ret_line.)
    fwrite(errhandle,[                                                 <strong>Atenção:</strong>]+&ret_line.)
    fwrite(errhandle,[                                           </font>]+&ret_line.)
    fwrite(errhandle,[                                           <font color="#FFFFFF" size="2" face="Arial, Helvetica, sans-serif">Contamos com sua atenção no preenchimento do formulário abaixo.</font>&nbsp;]+&ret_line.)
    fwrite(errhandle,[                                           </b>]+&ret_line.)
    fwrite(errhandle,[                                       </td>]+&ret_line.)
    fwrite(errhandle,[                                   </tr>]+&ret_line.)
    fwrite(errhandle,[                                   <tbody> ]+&ret_line.)
    fwrite(errhandle,[                            </table>]+&ret_line.)
    fwrite(errhandle,[                            <!-- ------------- INICIO DO BLOCO DE CAMPOS ------------ -->]+&ret_line.)
    fwrite(errhandle,[                            <table border="0" cellpadding="2" cellspacing="1" width="600" bgcolor="#FFFFFF">]+&ret_line.)
    do while .not. eof()
       if   field_type = 'L' .or. (field_type = 'C' .and. field_len = 1)
            // Cria controle checkbox
            fwrite(errhandle,[                            <tr bgcolor="#E8F0FF">]+&ret_line.)
            fwrite(errhandle,[                                <td width="135" align="right" bgcolor="#A8C8E8">]+&ret_line.)
            fwrite(errhandle,[                                    <font size="2" face="Arial, Helvetica, sans-serif">]+NewCapfirst(alltrim(field_name))+[</font>]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            fwrite(errhandle,[                                <td width="452">]+&ret_line.)
            fwrite(errhandle,[                                    <input align=left maxlength="135" type="checkbox" name="]+alltrim(field_name)+[" size="1" tabindex="]+str(recno(),2)+[">]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            fwrite(errhandle,[                            </tr>]+&ret_line.)
            skip
            loop
       endif
       /*
       if   field_type = 'D'
            // Cria controle data
            fwrite(errhandle,[                            <tr bgcolor="#E8F0FF">]+&ret_line.)
            fwrite(errhandle,[                                <td align="right" width="135" bgcolor="#A8C8E8">]+&ret_line.)
            fwrite(errhandle,[                                    <font size="2" face="Arial, Helvetica, sans-serif">]+alltrim(NewCapFirst(field_name))+[ <small>(dd/mm/yy)</small></font>]+&ret_line.)
            fwrite(errhandle,[                                    <font size="1"><small><br></small></font>]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            fwrite(errhandle,[                                <td width="452"> ]+&ret_line.)
            fwrite(errhandle,[                                    <select name="DIA_]+alltrim(field_name)+[" size="1" tabindex="]+str(recno(),2)+[">]+&ret_line.)
            fwrite(errhandle,[                                            <option selected value=""></option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="01">01</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="02">02</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="03">03</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="04">04</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="05">05</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="06">06</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="07">07</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="08">08</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="09">09</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="10">10</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="11">11</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="12">12</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="13">13</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="14">14</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="15">15</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="16">16</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="17">17</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="18">18</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="19">19</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="20">20</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="21">21</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="22">22</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="23">23</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="24">24</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="25">25</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="26">26</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="27">27</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="28">28</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="29">29</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="30">30</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="31">31</option>]+&ret_line.)
            fwrite(errhandle,[                                    </select>&nbsp;]+&ret_line.)
            fwrite(errhandle,[                                    <select name="MES_]+alltrim(field_name)+[" size="1" tabindex="]+str(recno(),2)+[">]+&ret_line.)
            fwrite(errhandle,[                                            <option selected value=""></option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="01">Janeiro</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="02">Fevereiro</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="03">Marco</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="04">Abril</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="05">Maio</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="06">Junho</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="07">Julho</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="08">Agosto</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="09">Setembro</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="10">Outubro</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="11">Novembro</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="12">Dezembro</option>]+&ret_line.)
            fwrite(errhandle,[                                    </select>&nbsp;]+&ret_line.)
            fwrite(errhandle,[                                    <select name="ANO_]+alltrim(field_name)+[" size="1" tabindex="]+str(recno(),2)+[">]+&ret_line.)
            fwrite(errhandle,[                                            <option selected value=""></option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="2000">2000</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="2001">2001</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="2002">2002</option>]+&ret_line.)
            fwrite(errhandle,[                                            <option value="2003">2003</option>]+&ret_line.)
            fwrite(errhandle,[                                    </select>]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            fwrite(errhandle,[                            </tr>]+&ret_line.)
       endif
       */
       if   field_type = 'C' .or. field_type = 'N' .or. field_type = 'D'
            // Cria controle text
            fwrite(errhandle,[                            <tr bgcolor="#E8F0FF">]+&ret_line.)
            fwrite(errhandle,[                                <td width="135" align="right" bgcolor="#A8C8E8">]+&ret_line.)
            fwrite(errhandle,[                                    <font size="2" face="Arial, Helvetica, sans-serif">]+NewCapfirst(alltrim(field_name))+[</font>]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            if field_len > 45
               // Cria controle textarea
               fwrite(errhandle,[                            <td width="452"> ]+&ret_line.)
               fwrite(errhandle,[                                <textarea align=left rows="3" cols="50" maxlength="300" size="50" tabindex="]+str(recno(),2)+[" type="text" name="]+alltrim(field_name)+["></textarea>]+&ret_line.)
               fwrite(errhandle,[                            </td>]+&ret_line.)
            else
               fwrite(errhandle,[                            <td width="452"> ]+&ret_line.)
               fwrite(errhandle,[                                <input align=left maxlength="135" type="text" name="]+alltrim(field_name)+[" size="]+str(field_len,2)+[" tabindex="]+str(recno(),2)+[">]+&ret_line.)
               fwrite(errhandle,[                            </td>]+&ret_line.)
            endif
            fwrite(errhandle,[                            </tr>]+&ret_line.)
       endif
       if   field_type = 'M'
            // Cria controle textarea
            fwrite(errhandle,[                            <tr bgcolor="#E8F0FF">]+&ret_line.)
            fwrite(errhandle,[                                <td width="135" valign="top" align="right" bgcolor="#A8C8E8">]+&ret_line.)
            fwrite(errhandle,[                                    <font size="2" face="Arial, Helvetica, sans-serif">]+NewCapfirst(alltrim(field_name))+[</font>]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            fwrite(errhandle,[                                <td width="452"> ]+&ret_line.)
            fwrite(errhandle,[                                    <textarea align=left rows="3" cols="50" maxlength="300" size="50" tabindex="]+str(recno(),2)+[" type="text" name="]+alltrim(field_name)+["></textarea>]+&ret_line.)
            fwrite(errhandle,[                                </td>]+&ret_line.)
            fwrite(errhandle,[                            </tr>]+&ret_line.)
       endif
       skip
    enddo
    fwrite(errhandle,[                            </table>]+&ret_line.)
    fwrite(errhandle,[                            <!-- ---------- INICIO DE PAGINA COMPLEMENTAR -------- -->]+&ret_line.)
    fwrite(errhandle,[                            <table border="0" cellpadding="2" cellspacing="1" width="600" bgcolor="#FFFFFF">]+&ret_line.)
    /*
    fwrite(errhandle,[                                   <tr bgcolor="#330066" align="center">]+&ret_line.)
    fwrite(errhandle,[                                       <td colspan="3"><font face="Arial, Helvetica, sans-serif">]+&ret_line.)
    fwrite(errhandle,[                                           <b><font color="#FFFFFF">Marque os tipos de informativos gostaria de receber em sua caixa de mensagem!</font></b></font>]+&ret_line.)
    fwrite(errhandle,[                                       </td>]+&ret_line.)
    fwrite(errhandle,[                                   </tr>]+&ret_line.)
    fwrite(errhandle,[                                   <tr bgcolor="#CCCCFF">]+&ret_line.)
    fwrite(errhandle,[                                       <td width="200"> <input type="checkbox" name="ezines" value="SB" > <font size="2" face="Arial, Helvetica, sans-serif">Produtos</font></td>]+&ret_line.)
    fwrite(errhandle,[                                       <td width="200"> <input type="checkbox" name="ezines" value="WP" > <font size="2" face="Arial, Helvetica, sans-serif">Servicos</font></td>]+&ret_line.)
    fwrite(errhandle,[                                       <td width="200"> <input type="checkbox" name="ezines" value="TR" > <font size="2" face="Arial, Helvetica, sans-serif">Internet</font></td></tr><tr bgcolor="#9999CC"> <td align="right" bgcolor="#330066" colspan="3"><img src="../imagens/spacer.gif" width="3" height="3"></td>]+&ret_line.)
    fwrite(errhandle,[                                   </tr>]+&ret_line.)
    fwrite(errhandle,[                                   <!-- ---------- INICIO DE BLOCO INFORMATIVO -------- -->]+&ret_line.)
    fwrite(errhandle,[                                   <tr bgcolor="#9999CC">]+&ret_line.)
    fwrite(errhandle,[                                       <td colspan="3"> ]+&ret_line.)
    fwrite(errhandle,[                                           <input type="checkbox" name="is_HTML_reader" value="Y" >]+&ret_line.)
    fwrite(errhandle,[                                           <font size="2" face="Arial, Helvetica, sans-serif">Gostaria de receber minhas mensagem atraves de minha area privativa no site.<br>]+&ret_line.)
    fwrite(errhandle,[                                           <font face="arial, helvetica" size="2" color="#660066">&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;Obs: Somente para clientes cadastrados via site.</font></font>]+&ret_line.)
    fwrite(errhandle,[                                       </td>]+&ret_line.)
    fwrite(errhandle,[                                   </tr>]+&ret_line.)
    */
    fwrite(errhandle,[                                   <tr bgcolor="#A8C8E8"> ]+&ret_line.)
    fwrite(errhandle,[                                       <td colspan="3"> ]+&ret_line.)
    fwrite(errhandle,[                                           <input type="checkbox" name="is_HTML_reader" value="Y" checked>]+&ret_line.)
    fwrite(errhandle,[                                           <font size="2" face="Arial, Helvetica, sans-serif">Pelo envio deste formulario quero garantir a atualizacao de meus dados nos cadastros SoftClever.</font>]+&ret_line.)
    fwrite(errhandle,[                                       </td>]+&ret_line.)
    fwrite(errhandle,[                                   </tr>]+&ret_line.)
    fwrite(errhandle,[                                   <tr bgcolor="#386898">]+&ret_line.)
    fwrite(errhandle,[                                       <td colspan="3"> ]+&ret_line.)
    fwrite(errhandle,[                                       <div align="center"><b>]+&ret_line.)
    fwrite(errhandle,[                                            <font face="Arial, Helvetica, sans-serif">]+&ret_line.)
    fwrite(errhandle,[                                            <font face="Arial, Helvetica, sans-serif" color="#FFFFFF"><br>]+&ret_line.)
    fwrite(errhandle,[                                            Clicando em '<b>Enviar formulario</b>!' seus dados serao armazenados em nossos cadastros on-line e uma saudacao lhe sera enviado o mais breve possivel.]+&ret_line.)
    fwrite(errhandle,[                                            </font>]+&ret_line.)
    fwrite(errhandle,[                                            <font face="Arial, Helvetica, sans-serif"><br>]+&ret_line.)
    fwrite(errhandle,[                                            </font>]+&ret_line.)
    fwrite(errhandle,[                                            <font size="2" face="Arial, Helvetica, sans-serif">]+&ret_line.)
    fwrite(errhandle,[                                            <font size="2" face="Arial, Helvetica, sans-serif">]+&ret_line.)
    fwrite(errhandle,[                                            <p>]+&ret_line.)
    fwrite(errhandle,[                                            <input type="submit" value=" Enviar formulario! " name="submit" style="color: #ffffff background-color: #3399ff" onClick="javascript:Cadastrar]+alltrim(NewCapFirst(prg_name))+[()">]+&ret_line.)
    fwrite(errhandle,[                                            <input type="reset"  value=" Cancelar envio "     name="reset"  style="color: #ffffff background-color: #3399ff">]+&ret_line.)
    fwrite(errhandle,[                                            </font>]+&ret_line.)
    fwrite(errhandle,[                                            </font>]+&ret_line.)
    fwrite(errhandle,[                                            <font face="Arial, Helvetica, sans-serif">]+&ret_line.)
    fwrite(errhandle,[                                            </font>]+&ret_line.)
    fwrite(errhandle,[                                            </font>]+&ret_line.)
    fwrite(errhandle,[                                            </b>]+&ret_line.)
    fwrite(errhandle,[                                       </div>]+&ret_line.)
    fwrite(errhandle,[                                       </td>]+&ret_line.)
    fwrite(errhandle,[                                   </tr>]+&ret_line.)
    fwrite(errhandle,[                            </table>]+&ret_line.)
    fwrite(errhandle,[                            <script language="javascript">]+&ret_line.)
    fwrite(errhandle,[                            function Cadastrar]+alltrim(NewCapFirst(prg_name))+[()]+&ret_line.)
    fwrite(errhandle,[                                     {]+&ret_line.)
    go top
    do while .not. eof()
       if field_type = 'N'
          fwrite(errhandle,[                                      if (isNaN(document.frm]+alltrim(NewCapFirst(prg_name))+[.]+alltrim(field_name)+[.value))]+&ret_line.)
          fwrite(errhandle,[                                         {]+&ret_line.)
          fwrite(errhandle,[                                            alert("O campo (]+alltrim(field_name)+[) deve ser numérico.")]+&ret_line.)
          fwrite(errhandle,[                                            document.frm]+alltrim(NewCapFirst(prg_name))+[.]+alltrim(field_name)+[.focus()]+&ret_line.)
          fwrite(errhandle,[                                            return]+&ret_line.)
          fwrite(errhandle,[                                         }]+&ret_line.)
       endif
       if field_type = 'C' .or. field_type = 'M'
          fwrite(errhandle,[                                      if (document.frm]+alltrim(NewCapFirst(prg_name))+[.]+alltrim(field_name)+[.value == "")]+&ret_line.)
          fwrite(errhandle,[                                         {]+&ret_line.)
          fwrite(errhandle,[                                            alert("Favor informar o conteudo do campo (]+alltrim(field_name)+[).")]+&ret_line.)
          fwrite(errhandle,[                                            document.frm]+alltrim(NewCapFirst(prg_name))+[.]+alltrim(field_name)+[.focus()]+&ret_line.)
          fwrite(errhandle,[                                            return]+&ret_line.)
          fwrite(errhandle,[                                         }]+&ret_line.)
       endif
       skip
    enddo
    fwrite(errhandle,[                                     document.frm]+alltrim(NewCapFirst(prg_name))+[.submit();]+&ret_line.)
    fwrite(errhandle,[                                     }]+&ret_line.)
    fwrite(errhandle,[                            </script>]+&ret_line.)
    fwrite(errhandle,[                     </form>]+&ret_line.)
    fwrite(errhandle,[                     <!-- END FORM HERE -->]+&ret_line.)
    fwrite(errhandle,[                 </td> ]+&ret_line.)
    fwrite(errhandle,[              </tr> ]+&ret_line.)
    fwrite(errhandle,[       </table>]+&ret_line.)
    fwrite(errhandle,[</table>]+&ret_line.)
    fwrite(errhandle,[</html>]+&ret_line.)
    fclose(errhandle)

    cFile := alltrim(prg_name) + ".ASP"
    ret_line := "chr(13)+chr(10)"

    errhandle = fcreate(cFile)

    fwrite(errhandle,[<table border=0  width=100%>]+&ret_line.)
    fwrite(errhandle,[<tr width=100%><td width=100% valign=top><h2>Cadastro de Cliente</h2></td></tr>]+&ret_line.)
    fwrite(errhandle,[<% DIM acao,usuario_id, ])
    go top
    do while .not. eof()
        fwrite( errhandle,lower(alltrim(field_name)) )
        skip
        if eof()
           fwrite(errhandle,&ret_line.)
        else
           fwrite(errhandle,[,])
        endif
    enddo
    fwrite(errhandle,['acao = Request.QueryString("acao")]+&ret_line.)
    fwrite(errhandle,[acao = Request.Form("acao")]+&ret_line.)
    fwrite(errhandle,['Checa o preenchimento do formulário]+&ret_line.)
    fwrite(errhandle,[If acao="inclusao" OR acao="atualizar" Then]+&ret_line.)
    //fwrite(errhandle,[        If acao="incluir" Then]+&ret_line.)
    //fwrite(errhandle,[                If (Request.Form("usuario") = "") Then erro = "XX" End If]+&ret_line.)
    //fwrite(errhandle,[                usuario = Request.Form("usuario")]+&ret_line.)
    //fwrite(errhandle,[        End If]+&ret_line.)
    go top
    do while .not. eof()
       fwrite(errhandle,[   If (Request.Form("]+upper(alltrim(field_name))+[") = "") Then erro = "XX" End If]+&ret_line.)
       skip
    enddo
    go top
    do while .not. eof()
       fwrite(errhandle,[   ]+lower(field_name)+[ = Request.Form("]+upper(alltrim(field_name))+[")]+&ret_line.)
       skip
    enddo
    go top
    fwrite(errhandle,[End If]+&ret_line.)
    fwrite(errhandle,[If erro = "XX" Then ]+&ret_line.)
    fwrite(errhandle,[   response.write ("<script>")]+&ret_line.)
    fwrite(errhandle,[   response.write ("      alert('Por favor, preencha todas informações.')")]+&ret_line.)
    fwrite(errhandle,[   response.write ("</script>")]+&ret_line.)
    fwrite(errhandle,[End If]+&ret_line.)
    fwrite(errhandle,[   ]+&ret_line.)
    fwrite(errhandle,['Se há algum erro no formulário volta para edição]+&ret_line.)
    fwrite(errhandle,[If erro = "XX" Then]+&ret_line.)
    fwrite(errhandle,[   Select Case acao]+&ret_line.)
    fwrite(errhandle,[               Case "atualizar"]+&ret_line.)
    fwrite(errhandle,[                    acao = "editar"]+&ret_line.)
    fwrite(errhandle,[               Case "incluir"]+&ret_line.)
    fwrite(errhandle,[                    acao = ""]+&ret_line.)
    fwrite(errhandle,[   End Select]+&ret_line.)
    fwrite(errhandle,[End If]+&ret_line.)
    fwrite(errhandle,[   ]+&ret_line.)
    fwrite(errhandle,['Inclui cliente]+&ret_line.)
    fwrite(errhandle,[If acao = "inclusao" AND erro = "" Then]+&ret_line.)
    fwrite(errhandle,[   pos    = instrrev(lcase(request.servervariables("path_translated")),lcase(scriptrelativefolder) & "\" & lcase(formaction))]+&ret_line.)
    fwrite(errhandle,[   db_dir = left(request.servervariables("path_translated"), pos-1 )]+&ret_line.)
    fwrite(errhandle,[   db     = db_dir & "\"]+&ret_line.)
    fwrite(errhandle,[   set cnn= server.createobject("adodb.connection")]+&ret_line.)
    fwrite(errhandle,[   cnn.open "Driver={Microsoft dBase Driver (*.dbf)};;DBQ=" & db & ";"]+&ret_line.)
    fwrite(errhandle,[   cnn.execute("INSERT INTO ]+alltrim(prg_name)+[(])
    go top
    do while .not. eof()
       fwrite(errhandle,lower(alltrim(field_name)))
       skip
       if eof()
          fwrite(errhandle,[)" &_]+&ret_line.)
       else
          fwrite(errhandle,[,])
       endif
    enddo
    fwrite(errhandle,[               "VALUES ('"&_]+&ret_line.)
    go top
    do while .not. eof()
       fwrite(errhandle,[                        ]+upper(alltrim(field_name)))
       skip
       if eof()
          //if field_type = 'N'
             fwrite(errhandle,[&")" )]+&ret_line.)
          //else
          //   fwrite(errhandle,[&"')" )]+&ret_line.)
          //endif
       else
          //if field_type = 'N'
             fwrite(errhandle,[&","&_]+&ret_line.)
          //else
          //   fwrite(errhandle,[&"',"&_]+&ret_line.)
          //endif
       endif
    enddo
    fwrite(errhandle,[   set cnn= nothing]+&ret_line.)
    fwrite(errhandle,[   response.write ("<script>")]+&ret_line.)
    fwrite(errhandle,[   response.write ("      alert('Operacao efetuada com sucesso!')")]+&ret_line.)
    fwrite(errhandle,[   response.write ("</script>")]+&ret_line.)
    fwrite(errhandle,[End If]+&ret_line.)

    fwrite(errhandle,['Atualiza informações]+&ret_line.)
    fwrite(errhandle,[If acao = "atualizar" Then]+&ret_line.)
    fwrite(errhandle,[   pos    = instrrev(lcase(request.servervariables("path_translated")),lcase(scriptrelativefolder) & "\" & lcase(formaction))]+&ret_line.)
    fwrite(errhandle,[   db_dir = left(request.servervariables("path_translated"), pos-1 )]+&ret_line.)
    fwrite(errhandle,[   db     = db_dir & "\"]+&ret_line.)
    fwrite(errhandle,[   set cnn= server.createobject("adodb.connection")]+&ret_line.)
    fwrite(errhandle,[   cnn.open "Driver={Microsoft dBase Driver (*.dbf)};;DBQ=" & db & ";"]+&ret_line.)
    fwrite(errhandle,[   cnn.execute("UPDATE ]+alltrim(prg_name)+[ set " &_]+&ret_line.)
    go top
    do while .not. eof()
       fwrite(errhandle,[                    "]+lower(alltrim(field_name))+[=']+lower(alltrim(field_name))+['])
       skip
       if eof()
          fwrite(errhandle,[ WHERE id=" & Session("usuario_id"))]+&ret_line.)
          //fwrite(errhandle,[ WHERE id=" & Session("usuario_id"))]+&ret_line.)
       else
          fwrite(errhandle,[" &_]+&ret_line.)
       endif
    enddo
    fwrite(errhandle,[   set cnn= nothing]+&ret_line.)
    fwrite(errhandle,[   response.write ("<script>")]+&ret_line.)
    fwrite(errhandle,[   response.write ("      alert('Atualizacao efetuada com sucesso!')")]+&ret_line.)
    fwrite(errhandle,[   response.write ("</script>")]+&ret_line.)
    fwrite(errhandle,[End If]+&ret_line.)
    fwrite(errhandle,[%>]+&ret_line.)
/*
If IsEmpty(acao) OR acao="" OR acao="editar" Then
   If IsEmpty(acao) OR acao="" Then
      %><tr width=100%><td width=100% valign=top>Por favor, preencha o formulário abaixo e clique em Enviar.</td></tr>
   <% Else %>
        <tr width=100%><td width=100% valign=top>Por favor, atualize seus dados no formulário e clique em Atualizar.</td></tr>   
   <% End If %>
   <tr align=left><td>
      <form method=post name=cadastro action="./cadastro.asp?acao=<%If acao="editar" Then Response.Write "atualizar" Else Response.Write "incluir" End If %><%If Not IsEmpty(Request.QueryString("pagina")) Then Response.Write"&pagina=" & Request.QueryString("pagina") End If%>">
      <table border=1>
      <tr><td>Nome&nbsp;de&nbsp;usuário&nbsp;:</td><td>
   <%
   If IsEmpty(acao) OR acao="" Then
      %>
      <input type=text size=12 maxlength=12 name=usuario value="<%=usuario%>">(até 12 caracteres)</td></tr>
      <%
   Else
      Response.Write Session("usuario")
   End If
   %>
   <tr><td>Senha :</td><td><input type=password size=8 maxlength=8 name=senha value="<%=senha%>">(até 8 caracteres)</td></tr>
   <tr><td>Redigite a Senha :</td><td><input type=password size=8 maxlength=8 name=senha2 value="<%=senha2%>">(até 8 caracteres)</td></tr>
   <tr><td>Nome :</td><td><input type=text size=50 maxlength=50 name=nome value="<%=nome%>"></td></tr>
   <tr><td>Sobrenome :</td><td><input type=text size=50 maxlength=50 name=sobrenome value="<%=sobrenome%>"></td></tr>   
   <tr><td>CPF :</td><td><input type=text size=15 maxlength=15 name=cpf value="<%=cpf%>"></td></tr>   
   <tr><td>Email :</td><td><input type=text size=50 maxlength=100 name=email value="<%=email%>"></td></tr>
   <tr><td>Telefone :</td><td><input type=text size=20 maxlength=20 name=telefone value="<%=telefone%>"></td></tr>
   <tr><td>Endereço :</td><td><input type=text size=50 maxlength=255 name=rua value="<%=rua%>"></td></tr>
   <tr><td>Bairro :</td><td><input type=text size=50 maxlength=50 name=bairro value="<%=bairro%>"></td></tr>
   <tr><td>Cidade :</td><td><input type=text size=50 maxlength=50 name=cidade value="<%=cidade%>"></td></tr>
   <tr><td>Estado :</td><td><input type=text size=2 maxlength=2 name=uf value="<%=uf%>"></td></tr>      
   <tr><td>CEP :</td><td><input type=text size=8 maxlength=8 name=cep value="<%=cep%>"></td></tr>
   <tr align=center><td colspan=2>
   <%
   If IsEmpty(acao) OR acao="" Then
      %>
      <input type=submit value="Cadastrar" onClick="this.value='Aguarde!'">
      <%
   Else
      %>
      <input type=submit value="Atualizar" onClick="this.value='Aguarde!'">
      <%
   End If      
   %>
   &nbsp;&nbsp;<input type=reset value="Limpar">
           </table> 
           </form>
           </td></tr>
    fwrite(errhandle,[<% End If %>]+&ret_line.)
    fwrite(errhandle,[</table>]+&ret_line.)
*/
    fclose(errhandle)
    use

RETURN

FUNCTION NewCapFirst
parameter string
declare excesao[7]
excesao[1] = " Do "
excesao[2] = " Dos "
excesao[3] = " Da "
excesao[4] = " Das "
excesao[5] = " De "
excesao[6] = " E "
excesao[7] = " Del "
novotexto = space(1)+lower(string)
fim = len(string)
for i = 1 to fim
   if substr(novotexto,i,1) = " "
      novotexto = stuff(novotexto,i+1,1,upper(substr(novotexto,i+1,1)))
   endif
next
tamanho = len(excesao)
for i = 1 to tamanho
   if excesao[i]$novotexto   && tamanho
      novotexto = stuff(novotexto,AT(excesao[i],novotexto),;
      len(excesao[i]),lower(excesao[i]))
   endif
next
RETURN(ltrim(novotexto))
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Formulário de Pedido Digital

Mensagempor rochinha » 06 Set 2018 21:46

DBF2FUNC.PRG
#include "fivewin.ch"

function main( cFile,p1,p2,p3,p4,p5,p6,p7,p8,p9,p10 )
    p1  := iif(p1=NIL,"",p1)
    p2  := iif(p2=NIL,"",p2)
    p3  := iif(p3=NIL,"",p3)
    p4  := iif(p4=NIL,"",p4)
    p5  := iif(p5=NIL,"",p5)
    p6  := iif(p6=NIL,"",p6)
    p7  := iif(p7=NIL,"",p7)
    p8  := iif(p8=NIL,"",p8)
    p9  := iif(p9=NIL,"",p9)
    p10 := iif(p10=NIL,"",p10)
    prg_name := alltrim(cfile)
    use (prg_name)
    copy structure extend to temp
    use
    use temp
    go top

    cFile := alltrim(prg_name) + '.prg'
    ret_line := "chr(13)+chr(10)"

    errhandle = fcreate(cFile)
    fwrite(errhandle,[#include "FiveWin.ch"]+&ret_line.)
    fwrite(errhandle,[//#include "]+upper(prg_name)+[.ch"]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[function Main( cLibName )]+&ret_line.)
    fwrite(errhandle,[   //]+&ret_line.)
    fwrite(errhandle,[   // -> Defina todos os OBJs iniciais ou conforme for necessario como LOCAL]+&ret_line.)
    fwrite(errhandle,[   LOCAL oWnd]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[   set date brit]+&ret_line.)
    fwrite(errhandle,[   set delete on]+&ret_line.)
    fwrite(errhandle,[   //]+&ret_line.)
    fwrite(errhandle,[   // -> Variaveis de suporte ao database]+&ret_line.)
    fwrite(errhandle,'   PUBLIC oFont[10],;'+&ret_line.)
    go top
    quantas := recco()
    for i = 1 to quantas
        if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
           fwrite(errhandle,[          ] )
        endif
        fwrite( errhandle,upper(alltrim(field_name)) )
        skip
        if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
           fwrite(errhandle,[, ;]+&ret_line. )
        else
           fwrite(errhandle,[, ] )
        endif
    next
    fwrite(errhandle,[ MyVAR ]+&ret_line. )
    fwrite(errhandle,[   //]+&ret_line. )
    fwrite(errhandle,[   // -> Abra os arquivos .DBF seguinte este exemplo]+&ret_line. )
    //fwrite(errhandle,[   USE ]+upper(prg_name)+[ INDEX ]+upper(prg_name)+[ NEW SHARED ]+&ret_line. )
    fwrite(errhandle,[   USE ]+lower(prg_name)+[ NEW SHARED ]+&ret_line. )
    fwrite(errhandle,[   SELE ]+upper(prg_name)+&ret_line. )
    fwrite(errhandle,[   CR_]+upper(prg_name)+[( "NOVO" )]+&ret_line. )
    fwrite(errhandle,[   GO TOP]+&ret_line. )

    fwrite(errhandle,'   DEFINE FONT oFont[1] NAME "MS Sans Serif" SIZE 6,15'+&ret_line. )
    fwrite(errhandle,'   DEFINE FONT oFont[2] NAME "Helv"          SIZE 6, 6'+&ret_line. )
    fwrite(errhandle,'   ACTIVATE FONT oFont[2] '+&ret_line. )
    fwrite(errhandle,[   SET 3DLOOK ON]+&ret_line. )
    fwrite(errhandle,[   DEFINE WINDOW oWnd TITLE "Reporting tools" MDI COLOR "N/W"]+&ret_line. )
    fwrite(errhandle,[          SET MESSAGE OF oWnd TO "" CENTERED]+&ret_line. )
    fwrite(errhandle,[   ACTIVATE WINDOW oWnd ON INIT ]+upper(prg_name)+[(oWnd) VALID MsgYesNo( "Deseja sair?" )]+&ret_line. )
    fwrite(errhandle,[   CLOSE ALL]+&ret_line. )
    fwrite(errhandle,[   return nil]+&ret_line. )
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[function ]+upper(prg_name)+[(oWnd)]+&ret_line. )
    fwrite(errhandle,[   local oLbx]+&ret_line. )
    fwrite(errhandle,[   DEFINE WINDOW oDlg TITLE "]+upper(prg_name)+[" MDICHILD OF oWnd]+&ret_line. )
    fwrite(errhandle,[             DEFINE BUTTONBAR oBar OF oDlg SIZE 24,24 _3D]+&ret_line. )
    fwrite(errhandle,[             @ 2, 1 LISTBOX oLbx ;]+&ret_line. )
    fwrite(errhandle,[             FIELDS ] )
    go top
    quantas := recco()
    for i = 1 to quantas
        if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
           fwrite(errhandle,[                   ] )
        endif
        if field_type = 'N'
           fwrite( errhandle,[STR( ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ )] )
        else
           if field_type = 'D'
              fwrite( errhandle,[DTOC( ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ )] )
           else
              if field_type = 'L'
                 fwrite( errhandle,[IF( ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ ,'S','N' )] )
              else
                 fwrite( errhandle,upper(prg_name)+[->]+upper(alltrim(field_name)) )
              endif
           endif
        endif
        skip
        if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
           fwrite(errhandle,[, ;]+&ret_line. )
        else
           if i # quantas
              fwrite(errhandle,[, ] )
           endif
        endif
    next
    fwrite(errhandle,[ ; ]+&ret_line. )
    fwrite(errhandle,[            HEADERS ] )
    go top
    quantas := recco()
    for i = 1 to quantas
        if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
           fwrite(errhandle,[                   ] )
        endif
        fwrite( errhandle,["]+upper(alltrim(field_name))+["] )
        skip
        if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
           fwrite(errhandle,[, ;]+&ret_line. )
        else
           if i # quantas
              fwrite(errhandle,[, ] )
           endif
        endif
    next
    fwrite(errhandle,[ ; ]+&ret_line. )
    fwrite(errhandle,[            FIELDSIZES ] )
    go top
    quantas := recco()
    for i = 1 to quantas
        if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
           fwrite(errhandle,[                   ] )
        endif
        fwrite( errhandle,str(field_len*10,5) )
        skip
        if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
           fwrite(errhandle,[, ;]+&ret_line. )
        else
           if i # quantas
              fwrite(errhandle,[, ] )
           endif
        endif
    next
    fwrite(errhandle,[ ; ]+&ret_line. )
    fwrite(errhandle,[            SIZE 20, 80 ;]+&ret_line.)
    fwrite(errhandle,[            OF oDlg ;]+&ret_line.)
    fwrite(errhandle,[            ON DBLCLICK EditClient( oLbx, "MOSTRA" )]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[          oLbx:nLineStyle := 0  // no lines]+&ret_line.)
    fwrite(errhandle,[          oLbx:bRClicked  := { | nRow, nCol | ShowPopup( nRow, nCol, oLbx ) }]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[          oDlg:SetControl( oLbx )]+&ret_line.)
    fwrite(errhandle,[          oDlg:nStyle := 1]+&ret_line.)
    fwrite(errhandle,[   ACTIVATE WINDOW oDlg VALID( oDlg := nil, .t. ) MAXIMIZED]+&ret_line.)
    fwrite(errhandle,[   return nil]+&ret_line.)

    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[FUNCTION CR_]+upper(prg_name)+[( TIPO_ACAO )]+&ret_line.)
    fwrite(errhandle,[   //]+&ret_line.)
    fwrite(errhandle,[   // -> Carrega variaveis para entrada ou altercao de dados]+&ret_line.)
    fwrite(errhandle,[   IF TIPO_ACAO = "NOVO"]+&ret_line.)
    fwrite(errhandle,[      GOTO BOTT]+&ret_line.)
    fwrite(errhandle,[      SKIP]+&ret_line.)
    fwrite(errhandle,[   ENDIF]+&ret_line.)
    go top
    do while .not. eof()
       fwrite(errhandle,[   M->]+upper(alltrim(field_name))+[ := ]+upper(prg_name)+[->]+upper(alltrim(field_name))+&ret_line.)
       skip
    enddo
    fwrite(errhandle,[   IF TIPO_ACAO = "NOVO"]+&ret_line.)
    fwrite(errhandle,[      //]+&ret_line.)
    fwrite(errhandle,[      // -> Deficao de valores constantes]+&ret_line.)
    fwrite(errhandle,[   ENDIF]+&ret_line.)
    fwrite(errhandle,[   RETURN .T.]+&ret_line.)
    fwrite(errhandle,[   ]+&ret_line.)
    fwrite(errhandle,[FUNCTION SV_]+upper(prg_name)+&ret_line.)
    fwrite(errhandle,[   //]+&ret_line.)
    fwrite(errhandle,[   // -> Salva o conteudo das variaveis de entrada no arquivo]+&ret_line.)
    go top
    do while .not. eof()
       fwrite(errhandle,[   ]+upper(prg_name)+[->]+upper(alltrim(field_name))+[ := M->]+upper(alltrim(field_name))+&ret_line.)
       skip
    enddo
    fwrite(errhandle,[   COMMIT]+&ret_line.)
    fwrite(errhandle,[   RETURN .T.]+&ret_line.)

    fwrite(errhandle,[//----------------------------------------------------------------------------//]+&ret_line.)
    fwrite(errhandle,[static function EditClient( oLbx, TIPO_ACAO )]+&ret_line.)
    fwrite(errhandle,[   LOCAL oDlg1, oFld1, oFont1]+&ret_line.)
    fwrite(errhandle,[   LOCAL ])
    go top
    quantas := recco()
    for i = 1 to quantas
        if (i=1.or.i=11.or.i=21.or.i=31.or.i=41.or.i=51.or.i=61)
           fwrite(errhandle,[         ] )
        endif
        fwrite(errhandle,[ oGet]+strzero(i,2))
        skip
        if (i=10.or.i=20.or.i=30.or.i=40.or.i=50.or.i=60)
           fwrite(errhandle,[, ;]+&ret_line. )
        else
           if i # quantas
              fwrite(errhandle,[, ] )
           endif
        endif
    next
    fwrite(errhandle,&ret_line.)
    fwrite(errhandle,[   LOCAL lSave := .f.]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[   SELE ]+upper(prg_name)+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[   CR_]+upper(prg_name)+[( TIPO_ACAO )]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[   DEFINE DIALOG oDlg1 RESOURCE "]+upper(prg_name)+[" TITLE "]+upper(prg_name)+["]+&ret_line. )
    go top
    quantas := recco()
    for i = 1 to quantas
        fwrite(errhandle,'   REDEFINE GET oGet'+strzero(i,2)+' VAR M->'+upper(alltrim(field_name))+' ID ID_'+upper(alltrim(field_name))+' OF oDlg1 PICTURE "" MESSAGE ""'+&ret_line.)
        skip
    next
    fwrite(errhandle,[   //@ 23,  9 BUTTON "&Aceitar"  OF oDlg1 SIZE 10,1 ACTION ( lSave := .t. , oDlg1:End() )]+&ret_line.)
    fwrite(errhandle,[   //@ 23, 19 BUTTON "&Cancelar" OF oDlg1 SIZE 10,1 ACTION ( lSave := .f. , oDlg1:End() )]+&ret_line.)
    fwrite(errhandle,[]+&ret_line.)
    fwrite(errhandle,[   ACTIVATE DIALOG oDlg1]+&ret_line.)
    fwrite(errhandle,[   IF lSave = .T.]+&ret_line.)
    fwrite(errhandle,[      IF TIPO_ACAO = "NOVO"]+&ret_line.)
    fwrite(errhandle,[         APPEND BLANK]+&ret_line.)
    fwrite(errhandle,[      //ELSE]+&ret_line.)
    fwrite(errhandle,[      //   REGLOCK]+&ret_line.)
    fwrite(errhandle,[      ENDIF]+&ret_line.)
    fwrite(errhandle,[      SV_]+upper(prg_name)+[()]+&ret_line.)
    fwrite(errhandle,[      oLbx:Refresh()]+&ret_line.)
    fwrite(errhandle,[   ENDIF]+&ret_line.)
    fwrite(errhandle,[return nil]+&ret_line.)
    fwrite(errhandle,[                                                                                ]+&ret_line.)
    fwrite(errhandle,[//----------------------------------------------------------------------------//]+&ret_line.)
    fwrite(errhandle,[static function ShowPopup( nRow, nCol, oLbx )                                   ]+&ret_line.)
    fwrite(errhandle,[   local oPopup                                                                 ]+&ret_line.)
    fwrite(errhandle,[   MENU oPopup POPUP                                                            ]+&ret_line.)
    fwrite(errhandle,[      MENUITEM "&Novo"      ACTION EditClient( oLbx, "NOVO" )                   ]+&ret_line.)
    fwrite(errhandle,[      MENUITEM "&Editar"    ACTION EditClient( oLbx, "MOSTRA" )                 ]+&ret_line.)
    fwrite(errhandle,[      MENUITEM "&Deletar"   ACTION DelClient( oLbx )                            ]+&ret_line.)
    fwrite(errhandle,[      MENUITEM "&Pesquisar" ACTION SeekClient( oLbx )                           ]+&ret_line.)
    fwrite(errhandle,[      MENUITEM "Im&primir"  ACTION oLbx:Report( "Listagem", .t. )               ]+&ret_line.)
    fwrite(errhandle,[      SEPARATOR                                                                 ]+&ret_line.)
    fwrite(errhandle,[      MENUITEM "&Sair"      ACTION oLbx:oWnd:End()                              ]+&ret_line.)
    fwrite(errhandle,[   ENDMENU                                                                      ]+&ret_line.)
    fwrite(errhandle,[   ACTIVATE POPUP oPopup AT nRow, nCol OF oLbx                                  ]+&ret_line.)
    fwrite(errhandle,[return nil                                                                      ]+&ret_line.)
    fwrite(errhandle,[                                                                                ]+&ret_line.)
    fwrite(errhandle,[//---------------------------------------------------------------------------// ]+&ret_line.)
    fwrite(errhandle,[static function DelClient( oLbx )                                               ]+&ret_line.)
    fwrite(errhandle,[   if MsgYesNo( "Tem certeza da exclusao deste registro?" )                     ]+&ret_line.)
    fwrite(errhandle,[      MsgRun( "Aguarde. Excluindo registro..." )                                ]+&ret_line.)
    fwrite(errhandle,[      RLOCK()                                                                   ]+&ret_line.)
    fwrite(errhandle,[      DELETE                                                                    ]+&ret_line.)
    fwrite(errhandle,[      COMMIT                                                                    ]+&ret_line.)
    fwrite(errhandle,[      MsgRun( "Atualizando esta listagem..." )                                  ]+&ret_line.)
    fwrite(errhandle,[      oLbx:UpStable()         // Corrige BUG no controle                        ]+&ret_line.)
    fwrite(errhandle,[      oLbx:Refresh()          // Refaz o listbox                                ]+&ret_line.)
    fwrite(errhandle,[   endif                                                                        ]+&ret_line.)
    fwrite(errhandle,[return nil                                                                      ]+&ret_line.)
    fwrite(errhandle,[                                                                                ]+&ret_line.)
    fwrite(errhandle,[//----------------------------------------------------------------------------//]+&ret_line.)
    fwrite(errhandle,[static function SeekClient( oLbx )                                              ]+&ret_line.)
    fwrite(errhandle,[   local cNombre := Space( 30 )                                                 ]+&ret_line.)
    fwrite(errhandle,[   local nRecNo  := RecNo()                                                     ]+&ret_line.)
    fwrite(errhandle,[   SET SOFTSEEK ON                                                              ]+&ret_line.)
    fwrite(errhandle,[   if MsgGet( "Pesquisar", "Sigla", @cNombre, "bmp\lupa.bmp" )                  ]+&ret_line.)
    fwrite(errhandle,[      if ! DbSeek( cNombre )                                                    ]+&ret_line.)
    fwrite(errhandle,[         MsgAlert( "Sigla nao encontrada" )                                     ]+&ret_line.)
    fwrite(errhandle,[         GO nRecNo                                                              ]+&ret_line.)
    fwrite(errhandle,[      else                                                                      ]+&ret_line.)
    fwrite(errhandle,[         oLbx:UpStable()           // Corrects same page stabilizing Bug        ]+&ret_line.)
    fwrite(errhandle,[         oLbx:Refresh()            // Repaint the ListBox                       ]+&ret_line.)
    fwrite(errhandle,[      endif                                                                     ]+&ret_line.)
    fwrite(errhandle,[   endif                                                                        ]+&ret_line.)
    fwrite(errhandle,[return nil                                                                      ]+&ret_line.)
    fclose(errhandle)
    use
RETURN
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes

Formulário de Pedido Digital

Mensagempor rochinha » 06 Set 2018 21:46

DBF2RC
// .DBF to .RC generator. Quickly create Dialogs from .DBFs
/*
File Name  : DBF2RC.PRG

Description: .DBF to .RC Generator. Quickly develop Dialogs from
              your .DBF

Modified   :
  07/26/95 : CLW : Now creates a VersionInfo and comment in
                   the .CH to show where the file came from.
  10/10/95 : Code partially formatted, Grokked & verified by QA Team
             Tested by QA under FiveWin 1.9
  12/10/95 : -3 bugs fixed by James Bott (Internet 71706.551@compuserve.com)
             -Labels now in proper case (first letter upper, rest lower).
             -Labels now right-justified.
             -Field lengths are more accurately predicted (a problem with
              proportional fonts).

Note: The version info may have to be deleted if you wish to import multiple
RC's into a DLL since each will have the same version info ID.
*/

#INCLUDE "FiveWin.ch"

STATIC cIniFile

//-------------------------------------------------------------//

FUNCTION Main()
   LOCAL oDlg, oGet
   LOCAL cDbfName := space( 40 )
   LOCAL cTemp

   SET _3DLOOK ON

   DEFINE DIALOG oDlg RESOURCE "Dbf2RC"

   REDEFINE GET oGet VAR cDbfName ID 110 OF oDlg

   REDEFINE BUTTON ID 120 OF oDlg                               ;
      ACTION ( cTemp :=                                         ;
      cGetfile( "*.dbf", "Select a DBF" ,,"..\data")          , ;
      if( !empty( cTemp ), ( cDbfName := cTemp ,                ;
          oGet:Refresh() ),))

   REDEFINE BUTTON ID 130 OF oDlg                               ;
      ACTION ( CursorWait(), GenRC( cDbfName ), CursorArrow() )

   REDEFINE BUTTON ID 140 OF oDlg ACTION oDlg:End()

   ACTIVATE DIALOG oDlg                                         ;
      CENTERED

RETURN( NIL )

//-------------------------------------------------------------//

FUNCTION GenRC( cDbfName )
   LOCAL n, nId   := 110
   LOCAL cRC      := ""
   LOCAL cCH      := "// Generated by DBF2RC" + CRLF
   LOCAL aFields
   LOCAL cRCFile  := ""

   IF empty( cDbfName ) .OR. !file( cDbfName )
      MsgAlert( "Please select a DBF file first!" )
      RETURN( NIL )
   ENDIF

   CursorWait()

   USE ( cDbfName ) NEW shared

   aFields := dbstruct()

   cRC += '#include "..\include\WinApi.ch"' + CRLF
   cRC += '#include "' + alias() + '.ch"' + CRLF + CRLF
   cRC += alias() + " DIALOG 32, 18, 236," + ;
      str( ( len( aFields ) * 14) + 20, 4 ) + CRLF
   cRC += "STYLE DS_MODALFRAME | WS_POPUP | WS_CAPTION |"+     ;
      " WS_SYSMENU" + CRLF
   cRC += 'CAPTION "' + alias() + '"' + CRLF
   cRC += 'FONT 8, "MS Sans Serif"' + CRLF
   cRC += "BEGIN" + CRLF

   FOR n := 1 TO len( aFields )
      cCH += "#define ID_" + PadR( aFields[ n ][ 1 ], 11 ) +    ;
         str( nId, 4 ) + CRLF

      DO CASE
         CASE aFields[ n ][ 2 ] $ "CND"
            cRC += '   RTEXT "' + properCase(aFields[n][1]) + '"' +     ;
               space(10-len( aFields[ n ][ 1 ] ) ) + ", -1, 3,"+;
               str( 5 + 14 * ( n - 1 ), 4 ) + ", 41, 8" + CRLF

            cRC += "   EDITTEXT ID_" + aFields[ n ][ 1 ] + ;
               ", 45," + str( 3 + 14 * ( n - 1 ), 4 ) + ", " + ;
               str( aFields[ n ][ 3 ] * 7 *.5 + 8, 4 ) + ", 12" + CRLF

         CASE aFields[ n ][ 2 ] == "L"
            cRC += '   CONTROL "' + properCase(aFields[ n ][ 1 ]) + ;
               '", ID_' + aFields[ n ][ 1 ] + ;
               ', "BUTTON", BS_AUTOCHECKBOX | WS_CHILD | WS_VISIBLE | WS_TABSTOP, ' + ;
               "45, " + str( 3 + 14 * ( n - 1 ), 4 ) + ;
               ", 50, 12" + CRLF

         CASE aFields[ n ][ 2 ] == "M"
            cRC += '   RTEXT "' + properCase(aFields[ n ][ 1 ]) + '"' + ;
               space( 10 - len( aFields[ n ][ 1 ] ) ) + ", -1, 100," + ;
               str( 5 + 14 * ( n - 1 ), 4 ) + ", 41, 8" + CRLF

            //            cRC += '   CONTROL "' + aFields[ n ][ 1 ] + ;
            cRC += '   CONTROL "' + "" + ;
               '", ID_' + aFields[ n ][ 1 ] + ;
               ', "EDIT", ES_LEFT | ES_MULTILINE | ES_WANTRETURN | WS_CHILD | WS_VISIBLE | WS_BORDER | WS_VSCROLL | WS_TABSTOP , ' + ;
               "145, " + str( 3 + 14 * ( n - 1 ), 4 ) + ", "  + "77, 63" + CRLF
            //^^^ gotta put it out to the right somewhere so you can see it
            //    and not sit under a bunch of other controls
      ENDCASE

      nId += 10

   NEXT

   cRC += "END" + CRLF

   /* Add version info to .RC */                         // CLW
   cRC += "" + CRLF
   cRC +='1 VERSIONINFO LOADONCALL MOVEABLE '+ CRLF
   cRC +='FILEVERSION 1, 0, 0, 0'            + CRLF
   cRC +='PRODUCTVERSION 1, 0, 0, 0'         + CRLF
   cRC +='FILEOS VOS__WINDOWS16'             + CRLF
   cRC +=' {'                                + CRLF
   cRC +=' BLOCK "StringFileInfo"'           + CRLF
   cRC +='  {'                               + CRLF
   cRC +='  BLOCK "040904E4"'                + CRLF
   cRC +='   {'                              + CRLF
   cRC +='   VALUE "ProductVersion", "Created by DBF2RC"'+ CRLF
   cRC +='   VALUE "FileVersion", " Created on '+               ;
      dtoc(date())+' at '+time()+'"'       + CRLF
   cRC +='   VALUE "FileDescription", "Generated by DBF2RC"'+CRLF
   cRC +='   }'                              + CRLF
   cRC +=''                                  + CRLF
   cRC +=' }'                                + CRLF
   cRC +=''                                  + CRLF
   cRC +='}'                                 + CRLF

   memowrit( alias() + ".ch", cCH )

   cRCFile := alias() + ".rc"

   CursorArrow()

   IF !file(alias() + ".rc")
      CursorWait()
      memowrit( alias() + ".rc", cRC )
   ELSEIF MsgYesno(                                             ;
      "That Resource Already Exists - Overwrite it?", "OOPS")
      CursorWait()
      memowrit( alias() + ".rc", cRC )
   ELSE
      MsgStop("Rename the existing " +cRCFile + " and try again")
   ENDIF

   CursorArrow()
   WinExec( "workshop" + " " + cRCFile )
   dbclosearea()

RETURN( NIL )

static function properCase(cString)
return left(cString,1)+ lower(right(cString,len(cString)-1))

//-------------------------------------------------------------//
OPS! LINK QUEBRADO? Veja ESTE TOPICO antes e caso não encontre ENVIE seu email com link do tópico para fivolution@hotmail.com. Agradecido.

@braços : ? )

A justiça divina tarda mas não falha, enquanto que a justiça dos homens falha porque tarda.
Avatar de usuário

rochinha
Membro Master

Membro Master
 
Mensagens: 4538
Data de registro: 18 Ago 2003 20:43
Cidade/Estado: São Paulo - Brasil
Curtiu: 800 vezes
Mens.Curtidas: 242 vezes




Retornar para Interface com Clientes

Quem está online

Usuários vendo este fórum: Nenhum usuário registrado online e 3 visitantes


Ola Amigo, espero que meu site e forum tem lhe beneficiado, com exemplos e dicas de programacao.
Entao divulgue o link da Doacao abaixo para seus amigos e redes sociais ou faça uma doacao para o site forum...
MUITO OBRIGADO PELA SUA DOACAO!
Faça uma doação para o forum
cron
v
Olá visitante, seja bem-vindo ao Fórum Clipper On Line!
Efetue o seu login ou faça o seu Registro