Douglas Soares

Bom Dia, um novo virus foi criado essa semana, é um tal de Induc, ele afeta a Lib do Delphi, e tudo que se compila ele joga seu virus no programa! Infelizmente peguei esse virus!, aprendi a remove-lo, é só entrar na pasta Lib do delphi, apagar o arquivo sysconst.dcu, e renomear o sysconst.bak para sysconst.dcu, porem hoje fui compilar e detectou virus dinovo! fui la e fiz o processo novamente! gostaria de saber como resolver o maldito por definitivo. Abraços

não é isso não, eu quis dizer, q eu poderia renomear os arquivos para começar com a data e em formato yyyymmdd, porem n vou fazer mais!, então eu já tenho o nome de antes que é backupddmmaaaa.zip, está dando erros, vou tentar fazer um debug, e em seguida posto. Abraços

Eu precisava refazer toda essa thread... por favor, alguém me ajude!

posta o código aqui, não da para a gente saber sem ver, ehehe abraço

tenta por isso aqui no event OnClick ClientDataSet.close; ClientDataSet.FetchOnDemand := true; ClientDataSet.PacketRecords := -1; ClientDataSet.open; Abraço

Somente com Try Except eu não conseguia resolver meu problema, então eu coloquei tambem on Error, agora sim, segue o código: try ................ except On E:Exception do begin //ShowMessage('Erro: ' + E.Message); frmEmailSuporte.cdsClientes.Edit; frmEmailSuporte.cdsClientes.FieldByName('ENVIOEMAIL').Value := 1; if frmEmailSuporte.cdsClientes.ApplyUpdates(0) > 0 then begin ShowMessage('Erro ao Gravar!'); Abort; end; frmEmailSuporte.cdsClientes.Next; Synchronize(Execute); end; end;

Use o Componente VCLSkin, e baixe um skin do Windows XP, segue alguns links: http://www.link-rank.com/ http://www.vclcomponents.com/Delphi/Form_E..._Skin-info.html http://www.alphaskins.com/ Abraços

Você tá querendo criar o form e exibi-lo na tela?, ou está querendo só criar para poder ter acesso a seus componentes visuais de outro form?, No caso de criar e exibir segue o código: formulario_consulta := Tformulario_consulta.create(application); try formulario_consulta.ShowModal; finally formulario_consulta.Release; formulario_consulta := nil; end; Para criar somente para usar os componentes visuais atravez de outro form, use o código abaixo: formulario_consulta := Tformulario_consulta.Create(Application); Obs: você não vai precisar de nenhum variavel..... usando somente um dos códigos acima no seu botão você irá conseguir! Abraço

ae jhonas disculpa a demora pra responder.... eu fiz isso mas n deu certo, olha o código todo! unit up_backup; interface uses Classes,SysUtils,IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,idftp, Forms, Windows, Messages, Dialogs, Controls, StdCtrls; type UploadBackup = class(TThread) private { Private declarations } protected procedure Execute; override; procedure Mensagem1; procedure Mensagem2; procedure _OnWork(ASender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); procedure _OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); procedure MeuArray; end; implementation uses BackupFb, Math; var datas: array of string; slBackups: TStringList; { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure UploadBackup.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; } { UploadBackup } procedure UploadBackup._OnWork(ASender: TObject; AWorkMode: TWorkMode; const AWorkCount: Integer); begin FrmBackupFb.Gauge1.Progress := AWorkCount; Application.ProcessMessages; end; procedure UploadBackup._OnWorkBegin(ASender: TObject; AWorkMode: TWorkMode; const AWorkCountMax: Integer); begin FrmBackupFb.Gauge1.Progress := 0; if AWorkCountMax > 0 then FrmBackupFb.Gauge1.MaxValue := AWorkCountMax else FrmBackupFb.Gauge1.MaxValue := bytesToTransfer; end; procedure UploadBackup.Mensagem1; begin MessageDlg('Backup realizado e enviado para sua Area Restrita com Sucesso!', mtInformation, [mbOk],0); end; procedure UploadBackup.Mensagem2; begin ShowMessage('Erro Desconhecido, tente novamente mais tarde!'); end; procedure UploadBackup.MeuArray; var i: Integer; valor, s: string; indice: Integer; ok: Boolean; begin //aloca espaço para os itens no vetor SetLength(datas,slBackups.Count); // retira parte da string e converte para data for i := 0 to slBackups.Count do begin s := copy(slBackups.Strings[i],7,8); insert('/',s,3); insert('/',s,6); datas[i] := 'backup'+(formatdatetime('dd/mm/yyyy',strtodate(s)))+'.zip'; end; // faz a ordenação repeat ok := False; indice := 0; repeat if CompareStr(datas[indice], datas[indice + 1]) = 2 then begin valor := datas[indice]; datas[indice] := datas[indice + 1]; datas[indice + 1] := valor; ok := True; end; Inc(indice); until(indice > High(datas)); until(ok = False); // fim ordenação // exibe o array ordenado no proprio listbox slBackups.Clear; for i := Low(datas) to High(datas) do begin delete(datas[i],9,1); delete(datas[i],11,1); slBackups.Append(datas[i]); end; end; procedure UploadBackup.Execute; var idftp1:tidftp; ftpconnect:integer; local : string; pastabackup : String; s_arquivo : string; begin slBackups := TStringList.Create; //*********** s_arquivo := 'backup' + FormatDateTime('ddmmyyyy', Date) + '.zip'; pastabackup := ExtractFilePath(Application.ExeName) + '\Area Restrita\' + s_arquivo; local := ExtractFilePath(Application.ExeName); frmBackupFB.idftp1:=tidftp.Create(nil); ftpconnect:=0; with frmBackupFB.idftp1 do begin Host := 'ftp.meusite.com.br'; // ftp Port := 21; ReadTimeout := 1000; Username := 'usuario'; Password := 'senha'; onWork := _OnWork; onWorkBegin := _OnWorkBegin; end; try frmBackupFB.idftp1.Connect; ftpconnect:=1; except Abort; ftpconnect := 0; end; if ftpconnect = 1 then begin try frmBackupFb.cdsParam.Open; try if (frmBackupFB.idftp1.Size(frmBackupFb.cdsParamCODIGO_I.AsString) >= 0) then frmBackupFB.idftp1.MakeDir(FrmBackupFb.cdsParamCODIGO_I.AsString); frmBackupFB.idftp1.ChangeDir(frmBackupFb.cdsParamCODIGO_I.AsString); frmBackupFB.idftp1.Put(pastabackup, s_arquivo); except if (frmBackupFB.idftp1.Size(frmBackupFb.cdsParamCODIGO_I.AsString) >= 0) then frmBackupFB.idftp1.MakeDir(FrmBackupFb.cdsParamCODIGO_I.AsString); frmBackupFB.idftp1.ChangeDir(frmBackupFb.cdsParamCODIGO_I.AsString); frmBackupFB.idftp1.Put(pastabackup, s_arquivo); end; try frmBackupFB.idftp1.List(slBackups, '*.zip', false); except end; Synchronize(MeuArray); if slBackups.Count > 2 then begin frmBackupFB.idftp1.Delete(slBackups.Strings[0]); end; Synchronize(Mensagem1); frmBackupFb.cdsParam.Close; FrmBackupFb.BitBtn2.Enabled := True; except Synchronize(Mensagem2); FrmBackupFb.BitBtn2.Enabled := True; frmBackupFB.idftp1.Abort; end; end; frmBackupFB.idftp1.Disconnect; frmBackupFB.idftp1.Free; FreeandNil(slBackups); end; end. Me ajudem :unsure: Abraço

Amigo, o seu problema é porque o ApplyUpdates está falhando, vamos ver primeiro qual o erro! vá nos events do seu clientdataset, de 2 cliques no event OnReconcileError, e lá coloque esse código: MessageDlg(E.Message,mtError,[mbOK],0); Após isso tente executar seu procedimento novamente, irá aparecer uma mensagem de erro!, tente resolver, caso não consiga responda esse tópico. Abraços

Fiz tipo uma newsletter para enviar mensagens para clientes, com uma imagem oferecendo atualizações... porem tem vez que ele para no meio do processo e não da erro!, fiz em modo de execução e peguei o danado do erro! ele dá que o email foi rejeitado! Teria como eu pular para o proximo se um email for rejeitado? p.s. uso IdSmtp e IdMessage! Obrigado

Amigo, eu uso um componente para zipar/descompactar o backup com o proprio delphi, e isso me gera uma dll, o nome do componente é zipmaster, segue alguns links: http://www.delphizip.org/ http://www.devmedia.com.br/articles/viewcomp.asp?comp=1293 http://scriptbrasil.com.br/forum/index.php...hlite=zipmaster Abraço

Ae Churc, na questão da imagem deu certo, porem ainda ta enviando um anexo em formato txt, mas é bobeira! Abraços

Olá, no tópico anterior descobri como envia imagens em html no email, ele envia ok, porem..... envia junto um arquivo maluco... uma numeração .txt anexado ao email... e demora muito para enviar pois ele pega a imagem que está no PC.... teria como eu pegar a imagem do meu site!, eu até tenho ela já! Segue o Código! procedure TfrmEmailSuporte.Button1Click(Sender: TObject); var idAttach: TidAttachment; idText1: TidText; idText2: TidText; p: TidMessageParts; slBody: TStringList; i : integer; nomeimg : string; caminhoimg : string; sistema : string; begin IdMessage1.Clear; IdMessage1.ClearBody; IdMessage1.ClearHeader; caminhoimg := 'C:\Propaganda Atualiza\'; if rbsigi.Checked = True then begin nomeimg := 'suporte_sigi.jpg'; sistema := 'Sigi'; end; if rbsigicell.Checked = True then begin nomeimg := 'suporte_sigicell.jpg'; sistema := 'SigiCell'; end; if rbsigiconv.Checked = True then begin nomeimg := 'suporte_sigiconv.jpg'; sistema := 'SigiConv'; end; if rbsigigrupos.Checked = True then begin nomeimg := 'suporte_sigigrupos.jpg'; sistema := 'SigiGrupos'; end; // idMessage1 has the email addresses and // all the other info needed to send already set. with IdMessage1 do begin Recipients.EMailAddresses:=edt_email.Text; Subject:='Atualização sistema ' + sistema; ContentType :='multipart/mixed'; ContentDisposition :='inline'; Encoding :=meMIME; end; p := idMessage1.MessageParts; slBody := TstringList.Create; try slBody.Add('<html>'); slBody.Add('<head>'); slBody.Add('</head>'); slBody.Add('<body>'); slBody.Add('<img src="cid:'+ nomeimg +'" />'); //procedure slBody.Add('</body>'); slBody.Add('</html>'); idText1 := TidText.Create(p, slBody); idText1.ContentType := 'text/html'; idText2 := TidText.Create(p); idText2.ContentType := 'text/plain'; idText2.Body.Text := ''; idAttach := TidAttachment.Create(p, caminhoimg + nomeimg); idAttach.ContentType := 'image/jpeg'; idAttach.ContentDisposition := 'inline'; idAttach.ExtraHeaders.Values['content-id'] := nomeimg; idMessage1.Body.Assign(slBody); idAttach.DisplayName := nomeimg; idMessage1.ContentType := 'multipart/mixed'; idSMTP1.Connect; idSMTP1.Send(idMessage1); finally idSMTP1.Disconnect; slBody.Free; Showmessage('Enviado'); end; end;

puxa fiz umas coisas malucas e funcionou!, mt obrigado, se quiserem o código é só falar ehehe

Olá pessoal, estou tentando fazer uma rotina que envie email para varias pessoas da lista de emails que tenho aqui, até ai é facil, o problema é eu inserir uma imagem no email!, eu não vou precisar de texto nenhum nesse email, sómente uma imagem!, por favor me ajudem! Abraços

Upa, substitua isso: ClientDataSet1.ApplyUpDates(-1); por isso: ClientDataSet1.ApplyUpDates(0); Abraço

O sistema já está pronto, estou na parte de fazer essa função toda que disse acima! eu consigo conectar e fazer varias coisas.... eu até já fiz o que eu escreve no post acima!, porem muitas vezes da ERRO! abraço

O négocio é o seguinte! ta meio complicado! eu fiz o processo porem quando incremento da o bendi erro "invalid floating point operation" esse codigo aqui funciona: insita um WebBrowser no form, 2 edits, um chama edt_usuario e outro chamado edt_senha. e um botão! depois use o código abaixo! Vai funcionar tranquilo! unit orkut; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, MSHTML, Buttons, ComObj, MOZILLACONTROLLib_TLB; type TForm1 = class(TForm) edt_usuario: TEdit; edt_senha: TEdit; Button1: TButton; Label1: TLabel; Label2: TLabel; WebBrowser1: TWebBrowser; procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} function GetFormByNumber(document: IHTMLDocument2; formNumber: integer): IHTMLFormElement; var forms: IHTMLElementCollection; begin forms := document.Forms as IHTMLElementCollection; if formNumber < forms.Length then result := forms.Item(formNumber,'') as IHTMLFormElement else result := nil; end; procedure SetFieldValue(theForm: IHTMLFormElement; const fieldName: string; const newValue: string; const instance: integer=0); var field: IHTMLElement; inputField: IHTMLInputElement; selectField: IHTMLSelectElement; textField: IHTMLTextAreaElement; begin field := theForm.Item(fieldName,instance) as IHTMLElement; if Assigned(field) then begin if field.tagName = 'INPUT' then begin inputField := field as IHTMLInputElement; if (inputField.type_ <> 'radio') and (inputField.type_ <> 'checkbox') then inputField.value := newValue else inputField.checked := (newValue = 'checked'); end else if field.tagName = 'SELECT' then begin selectField := field as IHTMLSelectElement; selectField.value := newValue; end else if field.tagName = 'TEXTAREA' then begin textField := field as IHTMLTextAreaElement; textField.value := newValue; end; end; end; procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var document: IHTMLDocument2; theForm: IHTMLFormElement; begin try WebBrowser1.OleObject.Document.All.Tags('input').item('email').value := edt_usuario.Text; WebBrowser1.OleObject.Document.All.Tags('input').item('passwd').value := edt_senha.Text; document := WebBrowser1.Document as IHTMLDocument2; theForm := GetFormByNumber(document,0); SetFieldValue(theForm,'gaia_loginform', 'signIn'); theForm.submit; except end; end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_F5 then Begin WebBrowser1.Refresh; End; end; procedure TForm1.Button1Click(Sender: TObject); begin WebBrowser1.Navigate('https://www.google.com/accounts/ServiceLogin?service=orkut&hl=pt-BR&rm=false&continue=http%3A%2F%2Fwww.orkut.com%2FRedirLogin.aspx%3Fmsg%3D0%26page%3Dhttp%253A%252F%252Fwww.orkut.com.br%252FHome.aspx&cd=BR&passive=true&skipvpage=true&sendvemail=false'); end; end. Porem isso dai, toda vez q eu ir para uma pagina vai fazer o processo e ficar dando erro, dai eu quero incrementar com uma variavel assim: unit orkut; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, SHDocVw, StdCtrls, ExtCtrls, MSHTML, Buttons, ComObj, MOZILLACONTROLLib_TLB; type TForm1 = class(TForm) edt_usuario: TEdit; edt_senha: TEdit; Button1: TButton; Label1: TLabel; Label2: TLabel; WebBrowser1: TWebBrowser; procedure WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Button1Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; entrar : integer; implementation {$R *.dfm} function GetFormByNumber(document: IHTMLDocument2; formNumber: integer): IHTMLFormElement; var forms: IHTMLElementCollection; begin forms := document.Forms as IHTMLElementCollection; if formNumber < forms.Length then result := forms.Item(formNumber,'') as IHTMLFormElement else result := nil; end; procedure SetFieldValue(theForm: IHTMLFormElement; const fieldName: string; const newValue: string; const instance: integer=0); var field: IHTMLElement; inputField: IHTMLInputElement; selectField: IHTMLSelectElement; textField: IHTMLTextAreaElement; begin field := theForm.Item(fieldName,instance) as IHTMLElement; if Assigned(field) then begin if field.tagName = 'INPUT' then begin inputField := field as IHTMLInputElement; if (inputField.type_ <> 'radio') and (inputField.type_ <> 'checkbox') then inputField.value := newValue else inputField.checked := (newValue = 'checked'); end else if field.tagName = 'SELECT' then begin selectField := field as IHTMLSelectElement; selectField.value := newValue; end else if field.tagName = 'TEXTAREA' then begin textField := field as IHTMLTextAreaElement; textField.value := newValue; end; end; end; procedure TForm1.WebBrowser1DocumentComplete(Sender: TObject; const pDisp: IDispatch; var URL: OleVariant); var document: IHTMLDocument2; theForm: IHTMLFormElement; begin if entrar = 1 then begin try WebBrowser1.OleObject.Document.All.Tags('input').item('email').value := edt_usuario.Text; WebBrowser1.OleObject.Document.All.Tags('input').item('passwd').value := edt_senha.Text; document := WebBrowser1.Document as IHTMLDocument2; theForm := GetFormByNumber(document,0); SetFieldValue(theForm,'gaia_loginform', 'signIn'); theForm.submit; except end; end; entrar := 0; end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if Key = VK_F5 then Begin WebBrowser1.Refresh; End; end; procedure TForm1.Button1Click(Sender: TObject); begin entrar := 1; WebBrowser1.Navigate('https://www.google.com/accounts/ServiceLogin?service=orkut&hl=pt-BR&rm=false&continue=http%3A%2F%2Fwww.orkut.com%2FRedirLogin.aspx%3Fmsg%3D0%26page%3Dhttp%253A%252F%252Fwww.orkut.com.br%252FHome.aspx&cd=BR&passive=true&skipvpage=true&sendvemail=false'); end; procedure TForm1.FormCreate(Sender: TObject); begin entrar := 0; end; end. Só que desse jeito ai, da o bendito erro!, se puderem ver oque está ocorrendo agradeço!, ehehehe Abraços

o que você fez?, desinstalou o firebird do pc?, tente desinstar e instala-lo novamente!, e marque a opção copiar bliblioteca GDS para pasta system, isso ajuda! Abraço

cara, vou tentar aqui, se tiver parado esse erro, eu faço aqui para você, e te envio, eu já tinha começado, só tem o problema do erro mesmo, ehehe! Abraços ______________________________________________________ Omg, o erro parou... nossa, o orkut deve ter se adaptado, o unico erro é de segurança agora!, fala q não tem segurança, fora isso ta beleza, ehehe, vou fazer jaja te mando. Abraço

Se tu descobrir me fala!, como eu te disse, tenho uma aplicação que usa firebird 1.5, porem quando ponho para instalar no computador de alguém, o instalador já puxa o Firebird 1.5 junto =D, com o InnoSetup, você consegue instalar silenciosamente o FB, eehhe. Abraço

acho que você teria que instalar o driver do firebird, e para redistribuir você teria que mandar instalar o fb 1.5 para os outros ^^ Abraço

:lol: :lol: :lol: :lol: :lol: amigo, você precisa instalar o banco de dados, não é simplesmente colocar o arquivo do banco, rsrs Abraço

Creio que não vai funcionar, pois o webbrowser tem um bug, mesmo se você navegar para a pagina do orkut usando ele, e digitar login e senha manualmente, quando clicar no botão logar, ele da um erro maluco 'Invalid Floating point operation' que até hoje não vi quem concertasse, rsrsr Abraço