[Tutorial] Criando Launcher no Visual Basic 6 & Visual Basic .net

------------------------------------------------------------------------------------------------------

[Descrição]
Este tutorial ensina como criar um launcher de mu com a linguagem de programação, Visual Basic 6.

[Tutorial Desing]
1° Abra um Novo projeto no VB, va no Menu Project clique em "Add Form", abra denovo o Menu Project e clique em "Add Module".

2° Renomeie o Form1 para "frmMain", e o Form2 para "frmOpções" na propriedade Name (F4) (Sem "")

3° Abra o frmMain como Desing e adicione os seguintes componentes:
Código:

3 CommandButtons 2 Labels

4° Aperte CRTL + T e Selecione os seguintes componentes:
Código:

Microsoft Winsock Control 6.0 Microsoft Internet Controls

Aperte OK, coloque no frmMain os 2 componentes um de cada.

5° Agora aperte F4 vai aparecer uma janela de propriedades, selecione o Command1 e mude o Caption Dele para "Jogar", o Caption do Command2 para "Opções", e o Caption do Command3 para "Sair".
Selecione o Label1 e mude o Caption para "Status:".

5° Arrume os Componentes nos seus lugares certos e deixe mais ou menos assim:


6° Abra o frmOpções, e adicione o seguintes componentes nele:
Citação:
2 CommandButton
1 TextBox
2 Frames
1 Label
2 CheckBox (Dentro do Frame1)
4 OptionButton (Dentro do Frame2")
Deixe mains ou menos assim:


7° Mude a Propriedade Name dos OptionButton para "valor_resolução" e a propriedade Index para 0 ate 3, cada OptionButton com sua Index.

8° Modifique as propriedades:
Código:

Command1, Propriedade Caption = Aplicar Command2, Propriedade Caption = Cancelar Frame1, Propriedade Caption = Som Frame2, Propriedade Caption = Resolução Check1, Propriedade Caption = Abilitar Som Check2, Propriedade Caption = Abilitar Efeitos valor_resolução(0), Propriedade Caption = 640 x 480 valor_resolução(1), Propriedade Caption = 800 x 600 valor_resolução(2), Propriedade Caption = 1024 x 768 valor_resolução(3), Propriedade Caption = 1280 x 1024 Label1, Propriedade Caption = Usuario

[Tutorial Codigo]
1° Va no Menu View e clique em Code. Vai aparecer uma janela de codigo, va na primeira linha e digite o seguinte codigo:
Código:
Código:

Dim IP, Site As String Dim Porta() As String Private Sub Command1_Click() Call Shell(App.Path & "\main.exe connect /u" & IP & " /p" & Porta(0), vbNormalFocus) End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Form_Load() Site = "www.google.com.br" IP = "127.0.0.1" Porta() = Split("44405;55901", ";") Call Winsock1.Connect(IP, Porta(1)) WebBrowser1.Navigate2 (Site) End Sub Private Sub Winsock1_Connect() Label2.Caption = "Online!" Label2.ForeColor = &HFF00& Winsock1.Close End Sub Private Sub Winsock1_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean) Label2.Caption = "Offline!" Label2.ForeColor = &HFF& Winsock1.Close End Sub Private Sub Command3_Click() frmOpções.Show End Sub

2° Abra o frmOpções, abre a janela de codigo e adicione o seguinte
Código:

Public Sub Carregar_Configurações() Dim resolução As Long Text1.Text = GetSettingString(HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "ID") Check1.Value = GetSettingLong(HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "MusicOnOff") Check2.Value = GetSettingLong(HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "SoundOnOff") resolução = GetSettingLong(HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "Resolution") Select Case resolução Case "0" valor_resolução(0).Value = True Case "1" valor_resolução(1).Value = True Case "2" valor_resolução(2).Value = True Case "3" valor_resolução(3).Value = True End Select End Sub Public Sub Salvar_Configurações() SaveSettingString HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "ID", Text1.Text SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "MusicOnOff", Check1.Value SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "SoundOnOff", Check2.Value If valor_resolução(0).Value = True Then SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "Resolution", "0" SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "ResolutionA", "0" ElseIf valor_resolução(1).Value = True Then SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "Resolution", "1" SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "ResolutionA", "0" ElseIf valor_resolução(2).Value = True Then SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "Resolution", "2" SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "ResolutionA", "0" ElseIf valor_resolução(3).Value = True Then SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "Resolution", "3" SaveSettingLong HKEY_CURRENT_USER, "Software\Webzen\Mu\Config", "ResolutionA", "1" End If End Sub Private Sub Command1_Click() Call Salvar_Configurações End Sub Private Sub Command2_Click() Unload Me End Sub Private Sub Form_Load() Call Carregar_Configurações End Sub

3° Abra o Module1 e coloque o seguinte codigo:
Código:

Option Explicit Public Const HKEY_CLASSES_ROOT = &H80000000 Public Const HKEY_CURRENT_USER = &H80000001 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const HKEY_USERS = &H80000003 Public Const HKEY_PERFORMANCE_DATA = &H80000004 Public Const HKEY_CURRENT_CONFIG = &H80000005 Public Const HKEY_DYN_DATA = &H80000006 Public Const REG_SZ = 1 Public Const REG_BINARY = 3 Public Const REG_DWORD = 4 Public Const ERROR_SUCCESS = 0& Public Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long Public Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long Public Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long Public Sub CreateKey(hKey As Long, strPath As String) Dim hCurKey As Long Dim lRegResult As Long lRegResult = RegCreateKey(hKey, strPath, hCurKey) If lRegResult <> ERROR_SUCCESS Then End If lRegResult = RegCloseKey(hCurKey) End Sub Public Sub DeleteKey(ByVal hKey As Long, ByVal strPath As String) Dim lRegResult As Long lRegResult = RegDeleteKey(hKey, strPath) End Sub Public Sub DeleteValue(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String) Dim hCurKey As Long Dim lRegResult As Long lRegResult = RegOpenKey(hKey, strPath, hCurKey) lRegResult = RegDeleteValue(hCurKey, strValue) lRegResult = RegCloseKey(hCurKey) End Sub Public Function GetSettingString(hKey As Long, strPath As String, strValue As String, Optional Default As String) As String Dim hCurKey As Long Dim lValueType As Long Dim strBuffer As String Dim lDataBufferSize As Long Dim intZeroPos As Integer Dim lRegResult As Long If Not IsEmpty(Default) Then GetSettingString = Default Else GetSettingString = "" End If lRegResult = RegOpenKey(hKey, strPath, hCurKey) lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, ByVal 0&, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then If lValueType = REG_SZ Then strBuffer = String(lDataBufferSize, " ") lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, 0&, ByVal strBuffer, lDataBufferSize) intZeroPos = InStr(strBuffer, Chr$(0)) If intZeroPos > 0 Then GetSettingString = Left$(strBuffer, intZeroPos - 1) Else GetSettingString = strBuffer End If End If Else End If lRegResult = RegCloseKey(hCurKey) End Function Public Sub SaveSettingString(hKey As Long, strPath As String, strValue As String, strData As String) Dim hCurKey As Long Dim lRegResult As Long lRegResult = RegCreateKey(hKey, strPath, hCurKey) lRegResult = RegSetValueEx(hCurKey, strValue, 0, REG_SZ, ByVal strData, Len(strData)) If lRegResult <> ERROR_SUCCESS Then End If lRegResult = RegCloseKey(hCurKey) End Sub Public Function GetSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, Optional Default As Long) As Long Dim lRegResult As Long Dim lValueType As Long Dim lBuffer As Long Dim lDataBufferSize As Long Dim hCurKey As Long If Not IsEmpty(Default) Then GetSettingLong = Default Else GetSettingLong = 0 End If lRegResult = RegOpenKey(hKey, strPath, hCurKey) lDataBufferSize = 4 lRegResult = RegQueryValueEx(hCurKey, strValue, 0&, lValueType, lBuffer, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then If lValueType = REG_DWORD Then GetSettingLong = lBuffer End If Else End If lRegResult = RegCloseKey(hCurKey) End Function Public Sub SaveSettingLong(ByVal hKey As Long, ByVal strPath As String, ByVal strValue As String, ByVal lData As Long) Dim hCurKey As Long Dim lRegResult As Long lRegResult = RegCreateKey(hKey, strPath, hCurKey) lRegResult = RegSetValueEx(hCurKey, strValue, 0&, REG_DWORD, lData, 4) If lRegResult <> ERROR_SUCCESS Then End If lRegResult = RegCloseKey(hCurKey) End Sub Public Function GetSettingByte(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, Optional Default As Variant) As Variant Dim lValueType As Long Dim byBuffer() As Byte Dim lDataBufferSize As Long Dim lRegResult As Long Dim hCurKey As Long If Not IsEmpty(Default) Then If VarType(Default) = vbArray + vbByte Then GetSettingByte = Default Else GetSettingByte = 0 End If Else GetSettingByte = 0 End If lRegResult = RegOpenKey(hKey, strPath, hCurKey) lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, ByVal 0&, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then If lValueType = REG_BINARY Then ReDim byBuffer(lDataBufferSize - 1) As Byte lRegResult = RegQueryValueEx(hCurKey, strValueName, 0&, lValueType, byBuffer(0), lDataBufferSize) GetSettingByte = byBuffer End If Else End If lRegResult = RegCloseKey(hCurKey) End Function Public Sub SaveSettingByte(ByVal hKey As Long, ByVal strPath As String, ByVal strValueName As String, byData() As Byte) Dim lRegResult As Long Dim hCurKey As Long lRegResult = RegCreateKey(hKey, strPath, hCurKey) lRegResult = RegSetValueEx(hCurKey, strValueName, 0&, REG_BINARY, byData(0), UBound(byData()) + 1) lRegResult = RegCloseKey(hCurKey) End Sub Public Function GetAllKeys(hKey As Long, strPath As String) As Variant Dim lRegResult As Long Dim lCounter As Long Dim hCurKey As Long Dim strBuffer As String Dim lDataBufferSize As Long Dim strNames() As String Dim intZeroPos As Integer lCounter = 0 lRegResult = RegOpenKey(hKey, strPath, hCurKey) Do lDataBufferSize = 255 strBuffer = String(lDataBufferSize, " ") lRegResult = RegEnumKey(hCurKey, lCounter, strBuffer, lDataBufferSize) If lRegResult = ERROR_SUCCESS Then ReDim Preserve strNames(lCounter) As String intZeroPos = InStr(strBuffer, Chr$(0)) If intZeroPos > 0 Then strNames(UBound(strNames)) = Left$(strBuffer, intZeroPos - 1) Else strNames(UBound(strNames)) = strBuffer End If lCounter = lCounter + 1 Else Exit Do End If Loop GetAllKeys = strNames End Function Public Function GetAllValues(hKey As Long, strPath As String) As Variant Dim lRegResult As Long Dim hCurKey As Long Dim lValueNameSize As Long Dim strValueName As String Dim lCounter As Long Dim byDataBuffer(4000) As Byte Dim lDataBufferSize As Long Dim lValueType As Long Dim strNames() As String Dim lTypes() As Long Dim intZeroPos As Integer lRegResult = RegOpenKey(hKey, strPath, hCurKey) Do lValueNameSize = 255 strValueName = String$(lValueNameSize, " ") lDataBufferSize = 4000 lRegResult = RegEnumValue(hCurKey, lCounter, strValueName, lValueNameSize, 0&, lValueType, byDataBuffer(0), lDataBufferSize) If lRegResult = ERROR_SUCCESS Then ReDim Preserve strNames(lCounter) As String ReDim Preserve lTypes(lCounter) As Long lTypes(UBound(lTypes)) = lValueType intZeroPos = InStr(strValueName, Chr$(0)) If intZeroPos > 0 Then strNames(UBound(strNames)) = Left$(strValueName, intZeroPos - 1) Else strNames(UBound(strNames)) = strValueName End If lCounter = lCounter + 1 Else Exit Do End If Loop Dim Finisheddata() As Variant ReDim Finisheddata(UBound(strNames), 0 To 1) As Variant For lCounter = 0 To UBound(strNames) Finisheddata(lCounter, 0) = strNames(lCounter) Finisheddata(lCounter, 1) = lTypes(lCounter) Next GetAllValues = Finisheddata End Function Pronto agora o seu Launcher ja esta Funcionando...

[Configurando]
Va no codigo do frmMain procure o codigo:
Código:
Código:

Private Sub Form_Load() Site = "www.google.com.br" IP = "127.0.0.1" Porta() = Split("44405;55901", ";") Call Winsock1.Connect(IP, Porta(1)) WebBrowser1.Navigate2 (Site) End Sub

Para modificar e so trocar:
Citação:
Código:

Site = "Seu Site" IP = "Seu IP" Porta() = Split("Porta do CS;Porta do GameServer", ";")

[Source VB6]
http://www.4shared.com/file/56410887...her_de_MU.html

[Source Launcher & Update VB6]
http://www.4shared.com/file/71371811..._By_EneMy.html
*Versão 4

[Source VB.NET]
http://www.4shared.com/file/69069759...rce_VBNET.html
* Para compilar e preciso ir no Menu:
Build > Build 'Nome do Projeto'
* O codigo esta todo comentado para melhor entendimento.

[Observações]
Esse launcher e Bem simples nivel Facil, qualquer um que leu pelo menos uma apostila de Visual Basic pode modifica-la com Facilidade.
O Desing esta Horrivel.. Mais eu fiz esse Tutorial para aprederem como criar, não mudar o IP / Porta e colocar pra download.
Qualquer pergunta, duvida, sugestão e so postar.

[Extras]
Aqui eu colocarei codigos e downloads que eu postei em todo topico.

Carregando Imagens:
Código:

Form1.Picture = LoadPicture("Arquivo de Imagem")

Download Visual Basic 6 (Testado):
http://www.megaupload.com/?d=EXU1LWTM
*Encontrado no forum usinavirtual. By Tuxx

Erro na DLL 'ieframe.dll':
Iniciar > Execultar, Escreva "regsvr32 shdocvw.dll" (Sem "") e dê Enter.

Compilando o Projeto (Gerando o Execultavel):
Menu, File > Make 'Nome do Projeto'.

Adicionando um Icone ao projeto:
Aperte F4 selecione a propriedade: Icon, vai aparecer [...] (três pontinhos) clique nele e selecione o icone.

Tirando a Borda e ScrollBar do Controle WebBrowser:
Código:

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) WebBrowser1.Document.body.Style.border = "none" WebBrowser1.Document.body.Scroll = "no" End Sub

Mudando a status da Janela (Maximizada, Minimizada..):
Tamanho Normal:
Código:

Me.WindowState = 0

Minimizado:
Me.WindowState = 1 [/CODE]
Maximizado:
Me.WindowState = 2 [/CODE]
Abrindo uma Pagina:
1° Declare este codigo no FrmMain:
Código:

Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Const SW_SHOWNORMAL = 1

2° Coloque esse sub dentro do Codigo do Form:
Código:

Public Sub AbrirPagina(URL As String) Call ShellExecute(Me.hwnd, vbNullString, URL, vbNullString, "C:", SW_SHOWNORMAL) End Sub

3° Para ezecultar o codigo e o seguinte:
Código:

AbrirPagina ("www.seusite.com.br")

Pack de OCXs e DLLs:
Código:

mscomctl.ocx msinet.ocx rar.dll mswinsck.ocx shdocvw.dll http://www.4shared.com/file/77525943/71ff2832/DLLs.html

[Creditos]
EneMy - Equip System

muito show