[ Tutorial ] Launcher de Jogos Básico no VB

]Descrição]
Este tutorial ensina como criar um launcher de mu ou qualquer outro jogo 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:

Quote3 CommandButtons
2 Labels

4° Aperte CRTL T e Selecione os seguintes componentes:

QuoteMicrosoft 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:".

6° Arrume os Componentes nos seus lugares certos e deixe mais ou menos assim:
[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]

7° Abra o frmOpções, e adicione o seguintes componentes nele:

Quote2 CommandButton
1 TextBox
2 Frames
1 Label
2 CheckBox (Dentro do Frame1)
4 OptionButton (Dentro do Frame2")


Deixe mains ou menos assim:
[Tens de ter uma conta e sessão iniciada para poderes visualizar esta imagem]

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

9° Modifique as propriedades:

QuoteCommand1, 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:
CODE


Dim IP, Site As String

Dim Porta() As String


CODE


Private Sub Command1_Click()

Call Shell(App.Path & "\main.exe connect /u" & IP & " /p" & Porta(0), vbNormalFocus)

End Sub

CODE


Private Sub Command2_Click()

Unload Me

End Sub

CODE


Private Sub Form_Load()

Site = "[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]

IP = "127.0.0.1"

Porta() = Split("44405;55901", ";")

Call Winsock1.Connect(IP, Porta(1))

WebBrowser1.Navigate2 (Site)

End Sub

CODE


Private Sub Winsock1_Connect()

Label2.Caption = "Online!"

Label2.ForeColor = &HFF00&

Winsock1.Close

End Sub

CODE


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

CODE


Private Sub Command3_Click()

frmOpções.Show

End Sub


2° Abra o frmOpções, abre a janela de codigo e adicione o seguinte
CODE


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

CODE


Private Sub Command1_Click()

Call Salvar_Configurações

End Sub

CODE


Private Sub Command2_Click()

Unload Me

End Sub

CODE


Private Sub Form_Load()

Call Carregar_Configurações

End Sub


3° Abra o Module1 e coloque o seguinte codigo:
CODE


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][/b

Va no codigo do frmMain procure o codigo:
CODE
[b]PrivateSubForm_Load()Site="[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]

IP ="127.0.0.1"Porta()=Split("44405;55901",";")CallWinsock1.Connect(IP,Porta(1))WebBrowser1.Navigate2(Site)EndSub


Para modificar e so trocar:

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




]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:

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



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:

QuotePrivate 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:

QuoteMe.WindowState = 0
Minimizado:
Código:
Me.WindowState = 1
Maximizado:
Código:
Me.WindowState = 2



Abrindo uma Pagina:

1° Declare este codigo no FrmMain:
CODE
PrivateDeclareFunctionShellExecuteLib"shell32.dll"Alias"ShellExecuteA"(ByVal hwnd AsLong,ByVal lpOperation AsString,ByVal lpFile AsString,ByVal lpParameters AsString,ByVal lpDirectory AsString,ByVal nShowCmd AsLong)AsLongConst SW_SHOWNORMAL =1


2° Coloque esse sub dentro do Codigo do Form:
CODE
PublicSubAbrirPagina(URL AsString)CallShellExecute(Me.hwnd, vbNullString, URL, vbNullString,"C:", SW_SHOWNORMAL)

End Sub


3° Para execultar o codigo e o seguinte:

QuoteAbrirPagina ("[Tens de ter uma conta e sessão iniciada para poderes visualizar este link]



Pack de OCXs e DLLs:

Quotemscomctl.ocx
msinet.ocx
rar.dll
mswinsck.ocx
shdocvw.dll





]Creditos]
EneMy [/font] [/url]

Aeee acabei de me Registrar e já achei esse Forum muito foda desejo muitos anos de vida para ele se quiser me contactar no msn adm ADD [Tens de ter uma conta e sessão iniciada para poderes visualizar este link] flw

BY: FOU-LU