Siga-nos em...
Follow us on Twitter Follow us on Facebook Watch us on YouTube
Registro


Alpha Servers
Resultados 1 a 1 de 1
  1. #1

    Avatar de ShotBolado
    Data de Ingresso
    Aug 2011
    Localização
    Cachoeiro de Itapemirim
    Posts
    8
    Agradecido
    1
    Peso da Avaliação
    0

    Padrão Criando Launcher - Visual Basic

    Muita gente que tem dificuldade de fazer o launcher nos tutoriais escritos, então ta aí essa vídeo aula desenvolvendo um launcher no Visual basic 6!

    houve um erro meu lá na linha
    Call Shell(App.Path & "main.exe connect /u" & IP & " /p" & Porta(0), vbNormalFocus)
    Troque por
    Call Shell(App.Path & "\main.exe connect /u" & IP & " /p" & Porta(0), vbNormalFocus)
    Module
    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
    Opções button Aplicar
    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
    Unload Me
    End Sub

    Private Sub Command2_Click()
    Unload Me
    End Sub

    Private Sub Form_Load()
    Call Carregar_Configurações
    End Sub
    [Somente usuários registrados podem vem os links. ]
    [Somente usuários registrados podem vem os links. ]


    Créditos

    GuilhermeM.



    Ajudei? Agradeça, não custa nada.

  2. O Seguinte Usuário Agradeceu ShotBolado Por este Post Útil:


 

 

Informações de Tópico

Usuários Navegando neste Tópico

Há 1 usuários navegando neste tópico. (0 registrados e 1 visitantes)

Tópicos Similares

  1. |Dúvida| Erro Visual Basic C++ Runtime Library
    Por dyooy2011 no fórum Dúvidas
    Respostas: 2
    Último Post: 28-07-2014, 03:47 AM
  2. |Suporte| Erro Visual Basic 6.0
    Por prosens no fórum Visual Basic
    Respostas: 3
    Último Post: 29-04-2012, 12:18 PM
  3. |Vídeo-aula| Criando Launcher - Visual Basic
    Por GuilhermeM. no fórum Launchers
    Respostas: 4
    Último Post: 01-08-2011, 07:48 PM
  4. |Tutorial| [Iniciante]Introdução ao Visual Basic
    Por FusioN no fórum Visual Basic
    Respostas: 0
    Último Post: 19-07-2010, 01:58 PM

Tags para este Tópico

Marcadores

Permissões de Postagem

  • Você não pode iniciar novos tópicos
  • Você não pode enviar respostas
  • Você não pode enviar anexos
  • Você não pode editar suas mensagens
  •