Banco de dados por email
04/06/2015
0
Olá.
Alguém poderia me informar um código tipo:
Ao fechar minha aplicação que apareça uma opção para copiar o banco de dados e enviar para um determinado email.
Desde já agradeço.
Alguém poderia me informar um código tipo:
Ao fechar minha aplicação que apareça uma opção para copiar o banco de dados e enviar para um determinado email.
Desde já agradeço.
Jean Carlos
Curtir tópico
+ 0
Responder
Posts
19/06/2015
Dorivan Sousa
qual o banco de dados? dependendo do banco vc faz o backup, de preferencia compacta e
para enviar email o ACBr tem um componente pra enviar email muito bom...
eu uso tambem essa unit (me parece que fizeram a partir do acbr)
para enviar email o ACBr tem um componente pra enviar email muito bom...
eu uso tambem essa unit (me parece que fizeram a partir do acbr)
unit uEnviarEmail; interface uses SysUtils, Types, Windows, smtpsend, ssl_openssl, mimemess, IniFiles, mimepart, Graphics, Contnrs, Classes; const Codes64 = '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz+/'; type TSendMailThread = class(TThread) private FException : Exception; procedure DoHandleException; function RetornaDadosProvedor(AChave, AValue : string) : string; public Terminado: Boolean; smtp : TSMTPSend; AFonteDados : string; sFrom : String; sTo : String; sSmtpHost, sSmtpPort, sSmtpUser, sSmtpPasswd : string; sCC : TStrings; slmsg_Lines : TStrings; constructor Create( AOwner : TComponent); Destructor Destroy; override ; function EnviarEmail(const sSmtpHost, sSmtpPort, sSmtpUser, sSmtpPasswd, sFrom, sTo, sAssunto: String; sMensagem : TStrings; SSL : Boolean; sCC: TStrings = nil; Anexos : TStrings = nil; PedeConfirma: Boolean = False; AguardarEnvio: Boolean = False; NomeRemetente: String = ''; TLS : Boolean = True) : boolean; protected procedure Execute; override; procedure HandleException; end; implementation Uses Forms, StrUtils, dateutils; function Desincriptar(S: string): string; var i: integer; a: integer; X: integer; b: integer; begin Result := ''; a := 0; b := 0; for i := 1 to Length(S) do begin X := Pos(S[i], Codes64) - 1; if X >= 0 then begin b := b * 64 + X; a := a + 6; if a >= 8 then begin a := a - 8; X := b shr a; b := b mod (1 shl a); X := X mod 256; Result := Result + chr(X); end; end else Exit; end; end; function TSendMailThread.RetornaDadosProvedor(AChave, AValue : string) : string; var cPath : string; begin cPath := AFonteDados; with TIniFile.Create(cPath) do begin try Result := ReadString(AChave, AValue, ''); finally Destroy; end; end; end; constructor TSendMailThread.Create( AOwner : TComponent ); begin smtp := TSMTPSend.Create; slmsg_Lines := TStringList.Create; sCC := TStringList.Create; sFrom := ''; sTo := ''; FreeOnTerminate := True; inherited Create(True); end; destructor TSendMailThread.Destroy; begin slmsg_Lines.Free; sCC.Free; smtp.Free; inherited; end; procedure TSendMailThread.Execute; var I: integer; begin inherited; try Terminado := False; try if not smtp.Login() then raise Exception.Create('SMTP ERROR: Login:' + smtp.EnhCodeString+sLineBreak+smtp.FullResult.Text); if not smtp.MailFrom( sFrom, Length(sFrom)) then raise Exception.Create('SMTP ERROR: MailFrom:' + smtp.EnhCodeString+sLineBreak+smtp.FullResult.Text); if not smtp.MailTo(sTo) then raise Exception.Create('SMTP ERROR: MailTo:' + smtp.EnhCodeString+sLineBreak+smtp.FullResult.Text); if (sCC <> nil) then begin for I := 0 to sCC.Count - 1 do begin if not smtp.MailTo(sCC.Strings[i]) then raise Exception.Create('SMTP ERROR: MailTo:' + smtp.EnhCodeString+sLineBreak+smtp.FullResult.Text); end; end; if not smtp.MailData(slmsg_Lines) then raise Exception.Create('SMTP ERROR: MailData:' + smtp.EnhCodeString+sLineBreak+smtp.FullResult.Text); if not smtp.Logout() then raise Exception.Create('SMTP ERROR: Logout:' + smtp.EnhCodeString+sLineBreak+smtp.FullResult.Text); finally try smtp.Sock.CloseSocket; except end ; Terminado := True; end; except Terminado := True; HandleException; end; end; procedure TSendMailThread.DoHandleException; begin if FException is Exception then Application.ShowException(FException) else SysUtils.ShowException(FException, nil); end; procedure TSendMailThread.HandleException; begin FException := Exception(ExceptObject); try // Não mostra mensagens de EAbort if not (FException is EAbort) then Synchronize(DoHandleException); finally FException := nil; end; end; function TSendMailThread.EnviarEmail(const sSmtpHost, sSmtpPort, sSmtpUser, sSmtpPasswd, sFrom, sTo, sAssunto: String; sMensagem : TStrings; SSL : Boolean; sCC: TStrings = nil; Anexos : TStrings = nil; PedeConfirma: Boolean = False; AguardarEnvio: Boolean = False; NomeRemetente: String = ''; TLS : Boolean = True) : boolean; var ThreadSMTP : TSendMailThread; m : TMimemess; p : TMimepart; StreamNFe : TStringStream; I : Integer; begin Result := False; m := TMimemess.create; ThreadSMTP := TSendMailThread.Create(Application); // Não Libera, pois usa FreeOnTerminate := True ; StreamNFe := TStringStream.Create(''); try p := m.AddPartMultipart('mixed', nil); if sMensagem <> nil then m.AddPartText(sMensagem, p); if assigned(Anexos) then for I := 0 to Anexos.Count - 1 do begin m.AddPartBinaryFromFile(Anexos[I], p); end; m.header.tolist.add(sTo); if Trim(NomeRemetente) <> '' then m.header.From := Format('%s<%s>', [NomeRemetente, sFrom]) else m.header.From := sFrom; m.header.subject:= sAssunto; m.Header.ReplyTo := sFrom; if PedeConfirma then m.Header.CustomHeaders.Add('Disposition-Notification-To: '+sFrom); m.EncodeMessage; ThreadSMTP.sFrom := sFrom; ThreadSMTP.sTo := sTo; if sCC <> nil then ThreadSMTP.sCC.AddStrings(sCC); ThreadSMTP.slmsg_Lines.AddStrings(m.Lines); ThreadSMTP.smtp.UserName := sSmtpUser; ThreadSMTP.smtp.Password := sSmtpPasswd; ThreadSMTP.smtp.TargetHost := sSmtpHost; if Trim(sSmtpPort)<>'' then // Usa default ThreadSMTP.smtp.TargetPort := sSmtpPort; ThreadSMTP.smtp.FullSSL := SSL; ThreadSMTP.smtp.AutoTLS := TLS; try ThreadSMTP.Resume; // inicia a thread if AguardarEnvio then begin repeat Sleep(1000); Application.ProcessMessages; until ThreadSMTP.Terminado; end; Result := True; except Result := False; end; finally m.free; StreamNFe.Free; end; end; end.
Responder
20/06/2015
Jean Carlos
Muito obrigado amigo vou fazer um teste, logo retorno com o resultado.
Responder
Clique aqui para fazer login e interagir na Comunidade :)