Ir para conteúdo
Fórum Script Brasil

MRMB

Membros
  • Total de itens

    180
  • Registro em

  • Última visita

Tudo que MRMB postou

  1. MRMB

    Ajuda (VB6) Teclas

    Densyy, Vou ficar devendo. Não conheço nenhum programa que faz alteração em DLL.
  2. MRMB

    Ajuda (VB6) Teclas

    Densyy, Pode acontecer o seguinte ao iniciar o jogo o processo Client.exe pode ser finalizado e iniciado outro processo. Com isso teria de validar o que aparece na guia processo do gerenciador de tarefas. Sobre o jogo, sendo "gratuito", poderia instalar ele só para validar o código. Mas, no momento não tem como, falta tempo.
  3. MRMB

    Ajuda (VB6) Teclas

    Densyy, No gerenciador de tarefas do windows caso não apareça o nome do jogo na aba "Aplicativos" verifique a aba "Processos". Caso não apareça na aba "Processos" não conheço até momento outro modo de identificar a execução. Em relação ao nome seria o contrário. Você colocaria o nome que aparece na aba "Processos". Não conheço esse jogo Mini Fighters. Ele seria pago? Tem versão gratuita?
  4. MRMB

    Ajuda (VB6) Teclas

    Densyy, Fiz algumas alterações para validar se o programa esta em execução e se a tela do programa esta ativa. Como exemplo utilizei o Word. Para testar no seu caso troque no código "winword.exe" pelo nome do seu jogo (que aparece no gerenciador de tarefas) e "Documento1 - Microsoft Word" pelo nome da tela do jogo. Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long Private esta_na_tela_do_jogo As Boolean Private Sub Command_Click() 'GetClassNameFromTitle ' VerificaTelaAtiva End Sub Private Sub Command1_Click() Timer1.Enabled = False Timer2.Enabled = False Label4.Caption = "Desativado" MsgBox "Função Desativada" End Sub Private Sub Command3_Click() If Text1.Text = "" Then MsgBox "Determine o Tempo 1 " Else If Text2.Text = "" Then MsgBox "Determine o Tempo 2 " Else If Text3.Text = "" Then MsgBox "Determine o Atraso" Else Timer1.Enabled = True Timer1.Interval = Text1.Text Sleep Text3.Text Timer2.Enabled = True Timer2.Interval = Text2.Text Label4.Caption = " Ativado" MsgBox "Função Ativada" End If End If End If End Sub Private Sub Form_Load() TimerTelaAtiva.Interval = 10 End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case vbKey0 To vbKey9 Case vbKeyBack, vbKeyClear, vbKeyDelete Case vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab Case Else KeyAscii = 0 Beep End Select End Sub Private Sub Text2_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case vbKey0 To vbKey9 Case vbKeyBack, vbKeyClear, vbKeyDelete Case vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab Case Else KeyAscii = 0 Beep End Select End Sub Private Sub Text3_KeyPress(KeyAscii As Integer) Select Case KeyAscii Case vbKey0 To vbKey9 Case vbKeyBack, vbKeyClear, vbKeyDelete Case vbKeyLeft, vbKeyRight, vbKeyUp, vbKeyDown, vbKeyTab Case Else KeyAscii = 0 Beep End Select End Sub Private Sub Timer1_Timer() ' Verifica se o jogo esta aberto If ProgramaAberto("winword.exe") Then If esta_na_tela_do_jogo Then _ SendKeys ("{UP}") End If End Sub Private Sub Timer2_Timer() ' Verifica se o jogo esta aberto If ProgramaAberto("winword.exe") Then If esta_na_tela_do_jogo Then _ SendKeys ("{X}") End If End Sub Private Sub TimerTelaAtiva_Timer() Static lHwnd As Long Dim lCurHwnd As Long Dim sText As String * 255 ' lCurHwnd = GetForegroundWindow If lCurHwnd = lHwnd Then Exit Sub lHwnd = lCurHwnd ' If lHwnd <> hwnd Then ' Caption = "Janela Ativa: " & Left$(sText, GetWindowText(lHwnd, ByVal sText, 255)) ' Else ' Caption = "Janela Ativa : Form1" ' End If estanateladojogo = "Documento1 - Microsoft Word" = Left$(sText, GetWindowText(lHwnd, ByVal sText, 255)) End Sub Public Function ProgramaAberto(strNomedoPrograma As String) As Boolean On Error Resume Next ' Não retornará erro. Dim oWMI Dim ret Dim oServices Dim oService Dim servicename ProgramaAberto = False Set oWMI = GetObject("winmgmts:") Set oServices = oWMI.InstancesOf("win32_process") For Each oService In oServices servicename = LCase(Trim(CStr(oService.Name) & "")) If InStr(1, servicename, LCase(strNomedoPrograma), vbTextCompare) > 0 Then ProgramaAberto = True End If Next Set oServices = Nothing Set oWMI = Nothing Exit Function End Function segue os link que utilizei como base para implementar as alterações. Activate Any Window With API Descobrindo a janela ativa na área de Trabalho.
  5. MRMB

    Ajuda (VB6) Teclas

    Densyy, Seguinte, verificando o seu projeto encontrei algumas situações que pode levar ocorrer vários erros. Veja abaixo alguns pontos que penso que esta faltando no seu programa. 1 - É necessário identificar se determinado programa esta executando - no caso o seu jogo. Isso porque ao executar o seu programa e após informar os parâmetros da tela já começa a preencher com "X" onde for possível e isso irá causar erros. Ele pode informar "X" na tela do MSN, bloco de notas, Word etc. Sendo que ele só ira informar as teclas quando seu jogo estiver executando. 2 - É necessário identificar se a tela do programa esta ativa - no caso a tela do jogo. Isso para que você execute o sendkeys somente no jogo. Estou validando essas situações acima. O que você acha?
  6. MRMB

    Ajuda (VB6) Teclas

    Densyy, Sem problemas se não entendeu. Vamos começar novamente. Teria como você me passar o código fonte do seu programa? Assim poderia testar e ajudar melhor você.
  7. MRMB

    Ajuda (VB6) Teclas

    Densyy, Penso que você esteja certa o problema e de permissão. Lendo sobre o problema no link PROBLEMA: "Erro de Runtime 70: permissão negada" lembrei que já tive esse problema. Para resolver utilizei um utilitário de terceiro (CPAU.exe) que até hoje funciona muito bem. Onde posso informar usuário/senha com privilégio de administrador para executar determinado aplicativo. Segue abaixo o link : Registrar DLL/OCX pelo VB, Registrar DLL/OCX pelo VB utilizando função ShellExecute Você poderia utilizar essa ferramenta para executar o seu programa informando um usuário/senha. Possívelmente, o erro não ocorrerá mais.
  8. MRMB

    Ajuda (VB6) Teclas

    Densyy, Não conheço uma solução pronta para sua situação. Contudo, posso lhe dar algumas dicas. Primeira coisa que seu programa poderia fazer é simplesmente validar se o jogo esta executando e depois fazer uso do comando SendKeys/Timer. Até momento, não sei como identificar a tela que esta sendo exibindo determinada parte do jogo e quando começa a enviar comandos. De uma olhada neste link que demonstra a utilização do SendKeys VB6 SendKeys List
  9. Pessoal, Somente para constar a solução desse problema antigo. Fiz um código para apagar esses arquivos temporários. ' Método que apaga os arquivos temporários do Crystal Reports com tamanho iguam a zero. Public Sub EliminaArquivosTmp() Const strDir = "c:\" Const strArqTipo = "*.tmp" Dim strArquivo As String Dim Tamanho As Long Dim Aux As String strArquivo = Dir(strDir + strArqTipo) Do While strArquivo <> Empty Tamanho = FileLen(strDir + strArquivo) If Not Tamanho > 0 Then ' recupera o nome do arquivo Aux = Replace(strArquivo, ".tmp", "") ' Quando é menor ou igual a 4 caracteres e corresponde a um valor hexadecimal exclui o arquivo. If (Len(Aux) <= 4) And NomeArqHexadecimal(Aux) Then Kill strDir + strArquivo End If ' Verifica próximo arquivo strArquivo = Dir Loop End Sub Private Function NomeArqHexadecimal(str As String) As Boolean Const CaracteresHexadecimal = "0123456789ABCDEF" Dim i As Integer Dim caracter As String str = UCase(str) NomeArqHexadecimal = True For i = 1 To Len(str) caracter = Mid(str, i, 1) If InStr(CaracteresHexadecimal, caracter) = 0 Then NomeArqHexadecimal = False Exit For End If Next End Function
  10. Densyy, Apagar o registro e bem simples. Praticamente o mesmo código. On Error Resume Next Dim Reg As Object Set Reg = CreateObject("wscript.shell") Reg.RegDelete "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\Desktop" Set Reg = Nothing O detalhe do código acima é que você precisa saber o nome da chave que foi criada. No nosso caso foi criada a chave abaixo em negrito. Reg.RegWrite "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & "Desktop", App.Path & "\" & App.EXEName & ".exe" Caso você altere o nome da chave de Desktop para nome do seu programa tem que alterar os dois processos. Escrita do registro e remoção.
  11. MRMB

    SQL em VB6

    K-du, Utilizando Textbox vou ficar devendo. Contudo, penso que tem outras formas de fazer o que você quer. Veja abaixo dois artigos como base utilizando ListView e MSFLexgrid. ListView - Exibindo dados com busca dinâmica VB - Busca dinâmica com MSFlexgrid Contudo, penso que no seu caso a melhor opção seria utilizar o combobox. Quando usuário digitar no combobox você poderia realizar uma consulta na base de dados tendo como parâmetro o valor digitado pelo usuário. O retorno dessa consulta você atribuiria a propriedade "List" do componente e via código você abre a opção de seleção para usuário.
  12. Densyy, O código abaixo é para funcionar em qualquer pasta que seu aplicativo estiver. Private Sub Form_Load() Dim Reg As Object Set Reg = CreateObject("wscript.shell") Reg.RegWrite "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRENTVERSION\RUN\" & "Desktop", App.Path & "\" & App.EXEName & ".exe" Set Reg = Nothing End Sub fonte: http://www.tornadodigital.com.br/visualbas...araoligarpc.htm
  13. Enivaldo, Tentei criar um código que atenda a sua situação. Veja abaixo se o mesmo é válido para seu caso. Option Explicit Private Sub Command_Click() Dim i As Long Dim arrTexto1() As String Dim arrTexto2() As String Dim strAux As String arrTexto1 = Split("TESTE DE TESTE DA TESTE E TESTE DOS TESTE DAS TESTE NO TESTE NOS TESTE NA TESTE NAS") arrTexto2 = arrTexto1 For i = LBound(arrTexto1) To UBound(arrTexto1) arrTexto2(i) = VerificaPreposicao(arrTexto1(i)) Next i For i = LBound(arrTexto2) To UBound(arrTexto2) strAux = strAux + arrTexto2(i) Next i MsgBox strAux End Sub Private Function VerificaPreposicao(Texto As String) As String Select Case Texto Case "DE" Case "DA" Case "E" Case "DOS" Case "DAS" Case "NO" Case "NOS" Case "NA" Case "NAS" VerificaPreposicao = Empty ' Retorna o valor que achar melhor. Case Else VerificaPreposicao = Texto End Select End Function
  14. Kaleu50, Penso que a melhor linguagem a utilizar seja a que você domina e da necessidade do seu cliente no caso seu pai. Tente analisar as vantagens de utilizar .NET, Java, PHP entre outras com excelente qualidade. Tente levantar a quantidade de dados que esse sistema irá manipular para definir qual banco de dados era fazer uso (Tem opções gratuitas de boa qualidade). Tente dividir esse projeto: Primeira parte cadastro, segunda consulta e terceira impressão. Em cada etapa terá dificuldade distintas.
  15. Pink, Talvez quando ocorre alteração do arquivo a alteração pode ser gravada em um arquivo temporário. Outra possibilidade seria que após alteração não esta sendo salvo o arquivo, ou antes, de realizar download tenha que atualizar o diretório de FTP que você esta utilizando.
  16. Pedro A Pereira, Estava procurando isso. Teste aqui com sucesso. Só ocorreu erro ao localizar o diretório do Adobe arrumei e funcionou. Muito bom!
  17. eluancardoso, Verifica esse tópico (Resolvido)Aba navegador, penso que é o que você esta querendo.
  18. Rafa Hetfield, Da uma olhada neste link: Visual Basic e a Comunicação Paralela e Serial
  19. kuroi, A substituição do arquivo e tranqüila. Alterar permissão do arquivo é trabalhoso no Windows 7 mas não é difícil. Até momento venho trabalho com substituição da TLB. Caso encontre algum problema em relação a distribuição do aplicativo ou coisa do gênero coloco aqui.
  20. rafaelcpcunha, O código abaixo valida linhas/caracteres. Altera o mesmo para quando for 40 caracteres adicionar a quebra de linha (Enter) no evento KeyPress do componente. Penso que irá ficar fino. Option Explicit Private totalLines As Long Private Sub Command_Click() ValidaLinhasCaracteres End Sub Private Function ValidaLinhasCaracteres() As Integer Const QtdeMaxCarac = 10 ' Quantidade máxima de caracteres por linha. Dim totalLines() As String ' Cria um array de tipo string Dim i As Long ' Para controle do loop. ' Coloca no array criado a lista de linhas existentes na TextBox totalLines = Split(txtTeste.Text, vbCrLf) ' Valida quantidade Caracteres por linha. For i = LBound(totalLines) To UBound(totalLines) If Len(totalLines(i)) >= QtdeMaxCarac Then MsgBox "Número de caracteres na linha " & CStr(i + 1) & " superior a " & CStr(QtdeMaxCarac) End If Next i ' Retorna o número de linhas. ValidaLinhasCaracteres = UBound(totalLines) End Function
  21. Flavio MCZ, Qual é a versão do seu Windows 7 32 ou 64 bits?
  22. Thiago Albuquerque, Eu particularmente uso pouco instrução "Call". Você poderia listar os parâmetros que estão na variavel ConfiguraParametros. No caso você não poderia instanciar o objeto da forma abaixo: ' Essa é a melhor opção. Dim objTeste As EXTeste.clsTeste Set clsUsuario = New EXTeste.clsTeste Penso que utilizar "CreateObject" não seja uma boa opção pelo fato que ele terá de identificar/procurar a classe para instanciar.
  23. AlifyZ, Estou começando também com C# as dicas foram boas!
  24. kuroi, Muito bom seu comentário! Vamos para .NET.
  25. BRB, Sim é possivel. Abaixo um exemplo de comando "for". Sub Macro1() Dim iLinha As Integer Dim Qtde As Integer Dim ValorCel As Integer Qtde = 5 ' define a quantidade de linhas a percorrer na planilha. For iLinha = 2 To Qtde ' iLinha igual a dois para desconsiderar os títulos das colunas caso exista. ValorCel= Plan1.Cells(iLinha, 1).Value Plan1.Cells(iLinha, 2).Value = ValorCel Plan1.Cells(iLinha, 3).Value = "OK" Next iLinha MsgBox "Fim" End Sub Abaixo código com linhas e colunas. Sub Macro2() Dim iLinha As Integer Dim iColuna As Integer Dim Qtde As Integer Dim ValorCel As Integer Qtde = 5 ' define a quantidade de linhas a percorrer na planilha. QtdeCol = 5 ' define a quantidade de colunas a percorrer na planilha. For iLinha = 2 To Qtde ' iLinha igual a dois para desconsiderar os títulos das colunas caso exista. For iColuna = 1 To QtdeCol Plan1.Cells(iLinha, iColuna).Value = "OK" Next iColuna Next iLinha MsgBox "Fim" End Sub
×
×
  • Criar Novo...