Forum ViSiBLe

Bem Vindo
Se registrares neste fórum, podes fazer parte da nossa comunidade.Prezamos aqui pela participação ACTIVA de cada membro.


Atençao: Nao precisa Confirma a sua conta no hotmail (Basta Registrar e Começar a participar do forum.)
Precisamos de administradores e moderadores!! Clique Aqui!

Anuncio


    [ Tutorial ] Launcher de Jogos Básico no VB

    Compartilhe

    MrViSiBLe
    Fundador ViSiBLe
    Fundador ViSiBLe

    Número de Mensagens : 3688
    Idade : 24
    Localização : Cuiaba
    Agradecimentos Agradecimentos : 864
    Data de inscrição : 10/12/2008

    [ Tutorial ] Launcher de Jogos Básico no VB

    Mensagem por MrViSiBLe em 10/6/2010, 01:01

    ]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]
    Abra um Novo projeto no VB, va no Menu Project clique em "Add Form", abra denovo o Menu Project e clique em "Add Module".

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

    Abra o frmMain como Desing e adicione os seguintes componentes:

    Quote3 CommandButtons
    2 Labels

    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.

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

    Arrume os Componentes nos seus lugares certos e deixe mais ou menos assim:
    [Você precisa estar registrado e conectado para ver esta imagem.]

    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:
    [Você precisa estar registrado e conectado para ver esta imagem.]

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

    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]
    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 = "[Você precisa estar registrado e conectado para ver 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


    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


    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]Private
    SubForm_Load()Site="[Você precisa estar registrado e conectado para ver 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:

    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


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

    End Sub



    Para execultar o codigo e o seguinte:

    QuoteAbrirPagina ("[Você precisa estar registrado e conectado para ver este link.]



    Pack de OCXs e DLLs:

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





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


    _________________
    MrViSiBLe Gosto? agradeça. clique em [b]+ Ta Ai do lado Olha  >>>>>Nao Custa Nada[/b]
    [Você precisa estar registrado e conectado para ver esta imagem.]
    [Você precisa estar registrado e conectado para ver esta imagem.]
    [Você precisa estar registrado e conectado para ver esta imagem.]
    [Você precisa estar registrado e conectado para ver esta imagem.]

    RICARDO_DX
    NOOB
    NOOB

    Número de Mensagens : 1
    Idade : 26
    Agradecimentos Agradecimentos : 0
    Data de inscrição : 22/01/2011

    Re: [ Tutorial ] Launcher de Jogos Básico no VB

    Mensagem por RICARDO_DX em 1/22/2011, 13:52

    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 [Você precisa estar registrado e conectado para ver este link.] flw

    BY: FOU-LU

      Data/hora atual: 12/2/2016, 15:10