Ademir Pereira

Em busca de auxiliar o pessoal com a questão de abreviação de nomes e, também, porque precisei em um sistema que desenvolvi e nada encontrei, decidi compartilhar essa Function em Delphi para abreviar nomes. Testado e funcionando em meu sistema. Espero ser de serventia. Function AbreviaNome (fNome : String) : String; // BY ADEMIR PEREIRA --- Abrevia Nomes var i, cont, x : Integer; vAbreviado : String; vPalavra : array[1..10] of String; begin cont := 0; //zerando variaveis x := 0; fNome := trim(fNome); //retiro possíveos espaços de inicio e fim for i := 1 to length(fNome) do //tamanho total do nome completo begin x := x + 1; if fNome[x] <> ' ' then //verifico espaços entre os nomes begin vAbreviado := vAbreviado + copy(fNome,x,1); end else //separo o nome e sobrenomes através do espaçamento entre eles e begin // gravo separadamente em cada posição do vetor cont := cont + 1; vPalavra[cont] := vAbreviado; vAbreviado := trim(copy(fNome,x,100)); fNome := vAbreviado; vAbreviado := ''; x := 0; end; end; cont := cont + 1; //Aloca ultimo sobrenome (não abrevia) vPalavra[cont] := vAbreviado; vAbreviado := ''; vAbreviado := vPalavra[1]+' '; //Mantém nome principal for i := 2 to cont do //Montar Abreviatura begin if (cont <> i) then begin //verifica partículas para repeti-las e não abrevia-las if (trim(vPalavra) = 'DA') or (trim(vPalavra) = 'DE') or (trim(vPalavra) = 'DAS') or (trim(vPalavra) = 'DO') or (trim(vPalavra) = 'DOS') or (trim(vPalavra) = 'E') then vAbreviado := vAbreviado + vPalavra+' ' else //abrevio nomes a partir da posião dois do vetor até penúltimo sobrenome vAbreviado := vAbreviado + copy(vPalavra,1,1)+'. ' end else vAbreviado := vAbreviado + vPalavra; end; Result := vAbreviado; end;

Consegui resolver o problema, a solução funcionou alterando a chamada por schemas, ficando da seguinte maneira: iConfig.Load -1 Set Campos = Nothing Set Campos = iConfig.Fields 'Retirei schemas e troquei por cdo With Campos .Item(cdoSMTPUseSSL) = True .Item(cdoSMTPAuthenticate) = cdoBasic .Item(cdoSendUserName) = wUsuario .Item(cdoSendPassword) = wSenha .Item(cdoSMTPServer) = wSmtp .Item(cdoSendUsingMethod) = cdoSendUsingPort .Item(cdoSMTPAuthenticate) = 1 .Item(cdoSMTPServerPort) = wPorta .Item(cdoSMTPConnectionTimeout) = 100 .Update End With Set Msg = Nothing Set Msg = CreateObject("CDO.Message") With Msg Set .Configuration = iConfig .To = Trim(wDestino) .From = Trim(wDestino) .Subject = "Assunto" .HTMLBody = strHTML .Send End With Set Msg = Nothing Set iConfig = Nothing Set Campos = Nothing Dessa maneira ele funciona no Win 7, Win XP, Server 2003 e Sever 2008. Espero que ajude outras pessoas...

Se você quer o número de parcelas assimétricas, o correto é você permitir editar o valor das parcelas. Por exemplo, você define a quantidade de parcelas e depois o valor total será dividido por elas e carrega em parcelas iguais em um grid, aí então a pessoa edita o grid com o valor que ela quer em determinada parcela. Por exemplo: Valor Total = 100,00 Dividido em 5 x = 20,00 Aí vamos supor que eu quero a primeira e a segunda parcela nos valores de 30,00 1 = 30,00 2 = 30,00 O sistema somará essa duas dando um total de 60,00 que você subtrai de 100,00 que sobra 40,00 e depois divide esses 40,00 por 3 que é o restante das parcelas, ficando a 3, 4 e 5 parcela no valor de 13,33. É uma idéia, não sei se resolve.

Segue abaixo o código funcional: Set iConfig = Nothing Set iConfig = CreateObject("CDO.Configuration") iConfig.Load -1 Set Campos = Nothing Set Campos = iConfig.Fields With Campos .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 .Item("http://schemas.Microsoft.com/cdo/configuration/smtpauthenticate") = 1 .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.gmail.com" .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Usuario" .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Senha" .Update End With Set Msg = Nothing Set Msg = CreateObject("CDO.Message") With Msg Set .Configuration = iConfig .To = Trim(wDestino) .From = Trim(wDestino) .Subject = "Assunto" .HTMLBody = strHTML .Send End With Set Msg = Nothing Set iConfig = Nothing Set Campos = Nothing Funciona perfeitamente no Windows XP, porém no Seven e no Server 2003 ocorre o seguinte erro: O servidor rejeitou o endereõ do remetente. A resposta do servidor foi: 530 5.5.1 http://support.google.com/mail/bin/answer.py?answer=14257 Tentei de todas as formas alterando tudo que era possível no "schemas" e não funcionou nos dois SOs especificdos. Se alguém puder me dar uma ajuda, pois preciso que funcione, principalmente, no Seven. Agradeço desde já...