Ir para conteúdo
Fórum Script Brasil

Jhonas

Monitores
  • Total de itens

    9.657
  • Registro em

Tudo que Jhonas postou

  1. nesse link tem um exemplo que voce pode modificar para o seu uso http://delphidabbler.com/tips/56 http://www.devmedia.com.br/dicas-extraindo-tags-html/982 nesse link tem outro exemplo ... voce pode jogar o conteudo do html para um memo, e depois procurar dentro dele e extrair a informação que precisa http://www.dicasdelphi.com.br/dica-vizualizando-html-no-componente-memo/ abraço
  2. showmessage(WebBrowser1.OleObject.Document.All.Tags('div').InnerHTML); usando esse comando voce consegue ver todas as tags < div > do html ?
  3. veja se esse post do forum resolve https://www.scriptbrasil.com.br/forum/topic/114777-resolvidowebbrowser-cookies/?p=472341 tente esse tambem procedure TForm1.Button2Click(Sender: TObject); begin // uses Wininet InternetSetOption(0, INTERNET_OPTION_END_BROWSER_SESSION, nil, 0); end; OBS: me passa o diretório ( caminho ) onde fica os cookies em sua maquina ... acho que é possivel apagar o conteudo da pasta abraço
  4. Atualmente para burlar o captcha tenho que fechar e abrir o programa. fechar e abrir o programa indica que voce tem que atualizar algum comando ou rotina ( tipo dar um refresh ) Para não dar erros o código deve ser assim unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ComObj, ActiveX; procedure ClearInternetExplorerHistory; const CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}'; type TSTATURL = record cbSize: DWORD; pwcsUrl: DWORD; pwcsTitle: DWORD; ftLastVisited: FILETIME; ftLastUpdated: FILETIME; ftExpires: FILETIME; dwFlags: DWORD; end; IEnumSTATURL = interface(IUnknown) ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}'] function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall; function Skip(celt: Longint): HRESULT; stdcall; function Reset: HResult; stdcall; function Clone(out ppenum: IEnumSTATURL): HResult; stdcall; function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall; end; IUrlHistoryStg = interface(IUnknown) ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}'] function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall; function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall; function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall; function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall; function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall; end; IUrlHistoryStg2 = interface(IUrlHistoryStg) ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}'] function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer; fWriteHistory: Integer; var poctNotify: Pointer; const punkISFolder: IUnknown): HResult; stdcall; function ClearHistory: HResult; stdcall; end; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure ClearInternetExplorerHistory; var stg: IUrlHistoryStg2; begin stg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2; stg.ClearHistory; end; procedure TForm1.Button1Click(Sender: TObject); begin ClearInternetExplorerHistory; end; end. obs: tente adaptar o seu código a este abraço
  5. exemplo unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; NomeJanela : THandle; PHandle : THandle; PID, TID, R : DWORD; Escrever : DWORD; implementation {$R *.dfm} Procedure PegarHandle(Titulo:String); Begin NomeJanela := FindWindow(nil, pChar (Titulo)); If NomeJanela <= 0 Then Showmessage('Erro. Este processo não está em execução.') else TId := GetWindowThreadProcessId(NomeJanela, @PID); PHandle := OpenProcess(PROCESS_ALL_ACCESS,FALSE,PID); showmessage(inttostr(Tid)); showmessage(inttostr(PHandle)); end; Procedure ler(Endereco:dword); var Ler:dword; valor:integer; begin valor:= 0; ReadProcessMemory(PHandle,pointer(endereco),addr(valor),4,Ler); end; Procedure escreve(Endereco:dword ; valor: integer); var w:dword; begin writeprocessmemory(PHandle,pointer(endereco),addr(valor),4,w); end; procedure TForm1.Button1Click(Sender: TObject); begin PegarHandle('Monitor'); // nome da janela end; procedure TForm1.Button2Click(Sender: TObject); begin escreve (StrToInt ('$' + '083A9444'), StrToInt ('1')); end; end. ============================================================================== outro exemplo http://rodneypj.blogspot.com.br/2012/08/source-hack-para-paciencia-spider-com.html abraço
  6. ok amigo.... já que conseguiu, vou passar outra forma de fazer voce pode obter esse som e outros nesse link http://www.findsounds.com/ISAPI/search.dll?keywords=typewriter esse é o som de apenas uma tecla http://www.soundjay.com/communication/typewriter-key-1.wav esse é o som de varias teclas http://www.ringelkater.de/Sounds/2geraeusche_gegenst/typewr11.wav esse é o código mais simples unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, MPlayer, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; MediaPlayer1: TMediaPlayer; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); VAR texto : string; i, tx : integer; begin Texto:= 'Batatinha quando nasce, esparrama pelo chão, '+ 'o Bilitocera quando dorme, põe a mão na Bíblia do Delphi '+ ' pra quando acordar, estudar de novo!'; tx := length(Texto); // pega o amanho do texto memo1.Clear; MediaPlayer1.FileName := 'C:\MAQUINA\typewr11.wav'; MediaPlayer1.AutoOpen := TRUE; for i := 1 to tx do begin sleep(150); memo1.Lines.Text := memo1.Lines.Text + texto; memo1.refresh; MediaPlayer1.Play; end; MediaPlayer1.Stop; end; end. =============================================================================== nesse voce vai notar que, existe o som da folha sendo colocada na maquina depois a mensagem é teclada e aparece no memo ao chegar ao fim de uma linha digitada, ocorre o som do sininho indicando uma mudança de linha ao chegar ao final o som das teclas é desligado unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, MPlayer, StdCtrls; type TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; MediaPlayer1: TMediaPlayer; MediaPlayer2: TMediaPlayer; MediaPlayer3: TMediaPlayer; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); VAR texto : string; i, tx : integer; begin MediaPlayer3.FileName := 'C:\MAQUINA\TYPO.wav'; // efiando a folha na maquina MediaPlayer3.AutoOpen := TRUE; MediaPlayer3.Play; sleep(1000); //'1234567890123456789012345678901234567890123456789012345' Texto:= 'Batatinha quando nasce, esparrama pelo chão, o '+ 'Bilitocera quando dorme, põe a mão na Bíblia do Delphi '+ ' pra quando acordar, estudar de novo!'; tx := length(Texto); // pega o amanho do texto memo1.Clear; MediaPlayer1.FileName := 'C:\MAQUINA\tape.wav'; // som das teclas MediaPlayer1.AutoOpen := TRUE; for i := 1 to tx do begin if i = 120 then begin MediaPlayer1.Stop; MediaPlayer2.FileName := 'C:\MAQUINA\ding.wav'; // som do sininho ao fim da linha MediaPlayer2.AutoOpen := TRUE; MediaPlayer2.Play; end; sleep(150); memo1.Lines.Text := memo1.Lines.Text + texto; memo1.refresh; MediaPlayer1.Play; end; MediaPlayer1.Stop; end; end. OBS: veja que usei 3 MediaPlayers para que um seja sobreposto a outro na execução abraço
  7. veja tambem nesse link http://www.cryer.co.uk/brian/delphi/twebbrowser/clear_history.htm unit InternetExplorerHistory; interface uses Windows, ComObj, ActiveX; procedure ClearInternetExplorerHistory; const CLSID_CUrlHistory: TGUID = '{3C374A40-BAE4-11CF-BF7D-00AA006946EE}'; type TSTATURL = record cbSize: DWORD; pwcsUrl: DWORD; pwcsTitle: DWORD; ftLastVisited: FILETIME; ftLastUpdated: FILETIME; ftExpires: FILETIME; dwFlags: DWORD; end; IEnumSTATURL = interface(IUnknown) ['{3C374A42-BAE4-11CF-BF7D-00AA006946EE}'] function Next(celt: Integer; out elt; pceltFetched: PLongint): HRESULT; stdcall; function Skip(celt: Longint): HRESULT; stdcall; function Reset: HResult; stdcall; function Clone(out ppenum: IEnumSTATURL): HResult; stdcall; function SetFilter(poszFilter: PWideChar; dwFlags: DWORD): HResult; stdcall; end; IUrlHistoryStg = interface(IUnknown) ['{3C374A41-BAE4-11CF-BF7D-00AA006946EE}'] function AddUrl(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer): HResult; stdcall; function DeleteUrl(pocsUrl: PWideChar; dwFlags: Integer): HResult; stdcall; function QueryUrl(pocsUrl: PWideChar; dwFlags: Integer; var lpSTATURL: TSTATURL): HResult; stdcall; function BindToObject(pocsUrl: PWideChar; var riid: TIID; out ppvOut: Pointer): HResult; stdcall; function EnumUrls(out ppenum: IEnumSTATURL): HResult; stdcall; end; IUrlHistoryStg2 = interface(IUrlHistoryStg) ['{AFA0DC11-C313-11D0-831A-00C04FD5AE38}'] function AddUrlAndNotify(pocsUrl: PWideChar; pocsTitle: PWideChar; dwFlags: Integer; fWriteHistory: Integer; var poctNotify: Pointer; const punkISFolder: IUnknown): HResult; stdcall; function ClearHistory: HResult; stdcall; end; implementation procedure ClearInternetExplorerHistory; var stg: IUrlHistoryStg2; begin stg := CreateComObject(CLSID_CUrlHistory) as IUrlHistoryStg2; stg.ClearHistory; end; end.
  8. observe o código novamente, coloquei a sua parte tambem DeleteCache(true,true,true); abraço
  9. dessa maneira funciona unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls; type TForm1 = class(TForm) Button1: TButton; procedure Button1Click(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} uses WinInet; procedure DeleteCache(ACache, ACookies, AHistory:boolean); var lpEntryInfo: PInternetCacheEntryInfo; hCacheDir: LongWord; dwEntrySize: LongWord; begin if (not ACache) and (not ACookies) and (not AHistory) then// nothing to delete exit; dwEntrySize := 0; FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize); GetMem(lpEntryInfo, dwEntrySize); if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize; hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize); if hCacheDir <> 0 then begin repeat // delete cookies if (ACookies and ((lpEntryInfo^.CacheEntryType and COOKIE_CACHE_ENTRY) = COOKIE_CACHE_ENTRY)) // delete history or (AHistory and ((lpEntryInfo^.CacheEntryType and URLHISTORY_CACHE_ENTRY) = URLHISTORY_CACHE_ENTRY)) // delete "normal" cache or (ACache and ((lpEntryInfo^.CacheEntryType and NORMAL_CACHE_ENTRY) = NORMAL_CACHE_ENTRY)) then DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName); FreeMem(lpEntryInfo, dwEntrySize); dwEntrySize := 0; FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize); GetMem(lpEntryInfo, dwEntrySize); if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize; until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize); end; FreeMem(lpEntryInfo, dwEntrySize); FindCloseUrlCache(hCacheDir); end; procedure DeleteIECache; var lpEntryInfo: PInternetCacheEntryInfo; hCacheDir: LongWord; dwEntrySize: LongWord; begin { DeleteIECache } dwEntrySize := 0; FindFirstUrlCacheEntry(nil, TInternetCacheEntryInfo(nil^), dwEntrySize); GetMem(lpEntryInfo, dwEntrySize); if dwEntrySize>0 then lpEntryInfo^.dwStructSize := dwEntrySize; hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize); if hCacheDir<>0 then begin repeat DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName); FreeMem(lpEntryInfo, dwEntrySize); dwEntrySize := 0; FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize); GetMem(lpEntryInfo, dwEntrySize); if dwEntrySize>0 then lpEntryInfo^.dwStructSize := dwEntrySize; until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize) end; { hCacheDir<>0 } FreeMem(lpEntryInfo, dwEntrySize); FindCloseUrlCache(hCacheDir) end; { DeleteIECache } procedure TForm1.Button1Click(Sender: TObject); begin DeleteIECache; DeleteCache(true,true,true); end; end. abraço
  10. amigo, voce vai precisar dos seguintes componentes: 1 Button para acionar a rotina 1 Memo para mostrar o texto que esta sendo digitado 1 MediaPlayer para tocar o som no autofalante do pc OBS: pesquise na internet onde tem o som da tecla de uma maquina de escrever e faça o download para a sua maquina montagem da rotina 1- defina uma variavel string e atribua a mensagem de texto 2- defina uma variavel integer para pegar o tamanho do texto 3- limpe o memo 4- defina do MediaPlayer o FileName - caminho onde esta o arquivo de som 5- defina a propriedade AutoOpen do MediaPlayer para True 6- use um comando FOR para fazer um loop onde cada caracter do texto sera adicionado ao memo 7- use o comando Sleep para definir o tempo que leverá para o memo receber o proximo caracter 8- use o comando Memo1.Refresh para atualizar os caracteres no memo 9- na sequencia de um comando Play ( MediaPlayer ) para executar o som 10- ao finalizar o FOR voce para a execução do som OBS: tente fazer ... no maximo usara 15 linhas de comando se não conseguir, depois passo o rotina pronta para voce abraço
  11. se quiser algo mais sofisticado use o componente VideoGrabber para o delphi ( tem muitos outros controles para o video ) http://conexaodelphi.blogspot.com.br/2012/04/tvideograbber-video-sdk-for-delphi.html https://www.google.com.br/?gfe_rd=cr&ei=FosMVL2aENTHsAefqYDQDw&gws_rd=ssl#q=tvideograbber+delphi componente para download http://www.datastead.com/products/tvideograbber/download.html exemplo de demonstração do componente http://www.datastead.com/_releases/vidgrab_9.2.1.4_MainDemo.zip abraço
  12. tente assim abra um novo projeto e coloque um componente WMP unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, OleCtrls, WMPLib_TLB; type TForm1 = class(TForm) WindowsMediaPlayer1: TWindowsMediaPlayer; procedure FormActivate(Sender: TObject); procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); private { Private declarations } public { Public declarations } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer; var Resize: Boolean); begin WindowsMediaPlayer1.parent:=nil; WindowsMediaPlayer1.Align := alClient; WindowsMediaPlayer1.width:=form1.Width; WindowsMediaPlayer1.Height:=form1.Height-40; WindowsMediaPlayer1.parent:=form1; end; procedure TForm1.FormActivate(Sender: TObject); begin form1.WindowState := wsMaximized; WindowsMediaPlayer1.parent:=nil; WindowsMediaPlayer1.Align := alClient; WindowsMediaPlayer1.width:=form1.Width; WindowsMediaPlayer1.Height:=form1.Height-40; WindowsMediaPlayer1.parent:=form1; end; end. OBS: A janela ficara maximizada ao iniciar, juntamente com WMP ... clique no botão maximizar do form, e veja o que acontece. abraço
  13. Quero implementar um sistema que se ajuste automaticamente à todos os tamanhos, fullscreen. Ajustar resolução de Video Automaticamente - veja esses links https://www.scriptbrasil.com.br/forum/topic/172621-resolvidoresolucao-de-video/ http://www.planetadelphi.com.br/dica/6803/ajuste-automatico-da-resolu%C3%A7%C3%A3o abraço
  14. como eu disse não precisa instalar nada ( a não ser o MYSQL no Servidor ) .. mas se quiser criar um instalador, coloque somente o executavel ou outro arquivo que se fizer necessario ) para os clientes. não importa se 32 ou 64 bits .... as dlls terão que ficar na pasta c:\windows\system32 ( somente para os clientes ) abraço
  15. de preferencia deixe no local onde o MYSQL gerou o banco de dados, mas se voce quiser outro local, voce tera que mudar o local do banco no arquivo My.ini do MYSQL prefiro deixar no local onde ele cria o banco, pois facilita a manutenção e evita que usuarios fiquem mexendo nele. para criar e maipular as tabelas do MYSQL use o MYSQL-Front http://www.mysqlfront.de/pub/MySQL-Front_Setup.exe abraço
  16. Imagine que voce tem um micro que será o servidor e neste servidor estara o seu banco de dados ( MYSQL ) voce deverá então instalar e configurar o MYSQL nesse micro http://dicaetuto.blogspot.com.br/2010/03/como-configurar-bd-mysql-no-delphi.html o seu progama fara conexão com o banco via configuração atraves do componente ZConnection http://imasters.com.br/artigo/3405/mysql/delphi-zeus-e-mysql/ atraves de um Switch os micros clientes serão conectados ao servidor da rede, onde voce definirá no programa, o local onde esta o seu banco de dados ( pode ser o caminho padrão definido pelo MYSQL ou outro que voce definir ) o seu programa devera estar em cada maquina cliente ( não terá que fazer nenhuma instalação, apenas criar uma pasta e copiar o programa para essa pasta ) fazendo acesso ao servidor se quiser aumentar a velocidade de processamento, voce pode usar placas de rede 10/100/1000 Mb ou 1 Gb nos micros ( clientes e servidor ) o roteador ou switch tambem devera comportar essa velocidade abraço
  17. não precisa instalar na maquina do cliente .... na maquina do cliente voce copia somente umas 4 dlls na pasta system32 o MYSQL é instalado e configurado somente no servidor abraço
  18. titelgrid.Cells[1, Loop] := LThePlayList.Item[Loop].name; titelgrid.Cells[2, Loop] := LThePlayList.Item[Loop].getItemInfo('Genre'); titelgrid.Cells[3, Loop] := LThePlayList.Item[Loop].durationString; titelgrid.Cells[4, Loop] := LThePlayList.Item[Loop].sourceURL; se voce reparou esse código joga para uma stringgrid o nome da musica, o genero , a duração em minutos e o caminho da musica no hd obs: dimensione o tamanho do WMP no proprio form, ele ficara do mesmo tamanho ao finalizar o ciclo de musicas ( o teste que fiz o WMP ficou do mesmo tamanho ) abraço
  19. se quiser seguir minha opnião, sugiro que voce passe a usar o banco de dados MYSQL ( gratis ) https://downloads.skysql.com/archives/mysql-5.1/mysql-essential-5.1.55-win32.msi voce pode fazer o acesso pelo delphi usando componentes Zeos ( voce encontra na net para a versão do seu delphi - gratis ) http://www.devmedia.com.br/instalando-o-zeos-em-7-passos/12306 muito estavel e muito rapido trabalhando em rede e muito facil trabalhar com ele ( e sem futuras dores de cabeça ) abraço
  20. use essa ferramenta para criação e manipulação do banco de dados interbase ( QuickDesk ) http://baixarvista.com/download/sema-quickdesk-lite-2.7.rar/1f6f83c7d outras informações uteis sobre paradox X interbase http://www.delphibr.com.br/artigos/pdxvsib.php http://www.tecnobyte.com.br/dica9.html abraço
  21. Jhonas

    Click Webbrowser

    pode ser que o seu while fique em um loop constante .... para verificar use o break point do delphi para acompanhar a sequencia do processamento ( debug do delphi ) abraço
  22. coloque na propriedade DisplayFormat = ,0.00;-,0.00 coloque na propriedade EditFormat = ,0.00;-,0.00 caso ainda não resolva, o campo no Interbase pode ser definido como Double Precision abraço
  23. Jhonas

    Click Webbrowser

    coloque a parte do seu código onde voce chama a pagina e clica no botao para logar
  24. exemplo ... componente usercontrol http://www.planetadelphi.com.br/artigo/132/usercontrol---controle-os-usu%C3%A1rios-na-aplica%C3%A7%C3%A3o---parte-1/ outros links sobre o assunto https://www.google.com.br/?gfe_rd=cr&ei=G9oHVOj1HMTAqAWhiIHIBA#q=controle+de+usuarios+delphi abraço
  25. Jhonas

    Click Webbrowser

    sim ... atualize o seu IE Se estiver usando o Firefox Firefox > Menu > Ferramentas > Desenvolvedor Web > Depurar ou Firefox > Menu > Ferramentas > Desenvolvedor Web > Inspesionar com isso voce pode ver o código da pagina e achar o script com problema abraço
×
×
  • Criar Novo...