No estás conectado. Conéctate o registrate

[APORTE] Launcher 100% Funcional!!

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

1 [APORTE] Launcher 100% Funcional!! el Mar Abr 28, 2009 12:22 am

Wiky Wiky


USUARIO REGISTRADO
TODO EL PROCEDIMIENTO VA EN EL CLIENTE




1º Creamos un formulario llamado "FrmLauncher"

2º Dentro del FrmLauncher ponemos:

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
 
Private Sub Form_Load()
 
End Sub
 
Private Sub Image1_Click()
Call EmpezarJuego
End Sub
 
Private Sub Image2_Click()
Dim X
  X = ShellExecute(Me.hWnd, "Open", App.Path & "\AOSetup.exe", &O0, &O0, SW_NORMAL)
End Sub
 
Private Sub Image3_Click()
ShellExecute hWnd, "open", "http://www.tuweb.com.ar/", vbNullString, vbNullString, conSwNormal
End Sub
 
Private Sub Image4_Click()
'Dim X
'  X = ShellExecute(Me.hWnd, "Open", App.Path & "\AutoUpdate.exe", &O0, &O0, SW_NORMAL)
final = MsgBox("Este cliente ya esta actualizado!!.", vbCritical)
End Sub
Private Sub Image5_Click()
Unload Me
End Sub
 

3º En el mismo FrmLauncher creamos 5 "Image".

4º ahora buscamos :

Código:
Sub Main()


5º y remplazamos todo el SubMain() por este:

Código:
Sub Main()
frmLauncher.Show
End Sub
 
Sub EmpezarJuego()
On Error Resume Next
 
#If SeguridadAlkon Then
    InitSecurity
#End If
 
    Call WriteClientVer
    Call LeerLineaComandos
 
    If App.PrevInstance Then
        Call MsgBox("Argentum Online ya esta corriendo! No es posible correr otra instancia del juego. Haga click en Aceptar para salir.", vbApplicationModal + vbInformation + vbOKOnly, "Error al ejecutar")
        End
    End If
 
Dim f As Boolean
Dim ulttick As Long, esttick As Long
Dim timers(1 To 2) As Integer
 
    'usaremos esto para ayudar en los parches
    Call SaveSetting("ArgentumOnlineCliente", "Init", "Path", App.Path & "\")
   
    ChDrive App.Path
    ChDir App.Path
 
#If SeguridadAlkon Then
    'Obtener el HushMD5
    Dim fMD5HushYo As String * 32
    fMD5HushYo = md5.GetMD5File(App.Path & "\" & App.EXEName & ".exe")
    Call md5.MD5Reset
    MD5HushYo = txtOffset(hexMd52Asc(fMD5HushYo), 55)
   
    Debug.Print fMD5HushYo
#Else
    MD5HushYo = "0123456789abcdef"  'We aren't using a real MD5
#End If
   
    'Cargamos el archivo de configuracion inicial
    If FileExist(App.Path & "\init\Inicio.con", vbNormal) Then
        Config_Inicio = LeerGameIni()
    End If
   
   
    If FileExist(App.Path & "\init\ao.dat", vbArchive) Then
        Call LoadClientSetup
       
        If ClientSetup.bDinamic Then
            Set SurfaceDB = New clsSurfaceManDyn
        Else
            Set SurfaceDB = New clsSurfaceManStatic
        End If
    Else
        'Por default usamos el dinámico
        Set SurfaceDB = New clsSurfaceManDyn
    End If
   
   
    tipf = Config_Inicio.tip
   
    frmCargando.Show
    frmCargando.Refresh
   
    'frmConnect.version = "v" & App.Major & "." & App.Minor & " Build: " & App.Revision
    AddtoRichTextBox frmCargando.Status, "Buscando servidores....", 0, 0, 0, 0, 0, 1
 
#If UsarWrench = 1 Then
    frmMain.Socket1.Startup
#End If
 
    Call CargarServidores
'TODO : esto de ServerRecibidos no se podría sacar???
    ServersRecibidos = True
   
    AddtoRichTextBox frmCargando.Status, "Encontrado", , , , 1
    AddtoRichTextBox frmCargando.Status, "Iniciando constantes...", 0, 0, 0, 0, 0, 1
   
    Call InicializarNombres
   
    frmOldPersonaje.NameTxt.Text = Config_Inicio.Name
    frmOldPersonaje.PasswordTxt.Text = ""
   
    AddtoRichTextBox frmCargando.Status, "Hecho", , , , 1
   
    IniciarObjetosDirectX
   
    AddtoRichTextBox frmCargando.Status, "Cargando Sonidos....", 0, 0, 0, 0, 0, 1
    AddtoRichTextBox frmCargando.Status, "Hecho", , , , 1
 
Dim loopc As Integer
 
LastTime = GetTickCount
 
    Call InitTileEngine(frmMain.hWnd, 152, 7, 32, 32, 13, 17, 9)
   
    Call AddtoRichTextBox(frmCargando.Status, "Creando animaciones extra....")
   
    Call CargarAnimsExtra
    Call CargarTips
 
UserMap = 1
 
    Call CargarArrayLluvia
    Call CargarAnimArmas
    Call CargarAnimEscudos
    Call CargarVersiones
    Call CargarColores
   
#If SeguridadAlkon Then
    CualMI = 0
    Call InitMI
#End If
 
    AddtoRichTextBox frmCargando.Status, "                    ¡Bienvenido a Argentum Online!", , , , 1
   
    Unload frmCargando
   
    'Inicializamos el sonido
    Call AddtoRichTextBox(frmCargando.Status, "Iniciando DirectSound....", 0, 0, 0, 0, 0, True)
    Call Audio.Initialize(DirectX, frmMain.hWnd, App.Path & "\" & Config_Inicio.DirSonidos & "\", App.Path & "\" & Config_Inicio.DirMusica & "\")
    Call AddtoRichTextBox(frmCargando.Status, "Hecho", , , , 1, , False)
   
    'Inicializamos el inventario gráfico
    Call Inventario.Initialize(DirectDraw, frmMain.picInv)
   
    If Musica Then
        Call Audio.PlayMIDI(MIdi_Inicio & ".mid")
    End If
 
    frmPres.Picture = LoadPicture(App.Path & "\Graficos\bosquefinal.jpg")
    'frmPres.Show vbModal    'Es modal, así que se detiene la ejecución de Main hasta que se desaparece
   
    frmConnect.Visible = True
 
'TODO : Esto va en Engine Initialization
    MainViewRect.Left = MainViewLeft
    MainViewRect.Top = MainViewTop
    MainViewRect.Right = MainViewRect.Left + MainViewWidth
    MainViewRect.Bottom = MainViewRect.Top + MainViewHeight
   
'TODO : Esto va en Engine Initialization
    MainDestRect.Left = TilePixelWidth * TileBufferSize - TilePixelWidth
    MainDestRect.Top = TilePixelHeight * TileBufferSize - TilePixelHeight
    MainDestRect.Right = MainDestRect.Left + MainViewWidth
    MainDestRect.Bottom = MainDestRect.Top + MainViewHeight
   
    'Inicialización de variables globales
    PrimeraVez = True
    prgRun = True
    pausa = False
   
    Do While prgRun
        'Sólo dibujamos si la ventana no está minimizada
        If frmMain.WindowState <> 1 And frmMain.Visible Then
            Call ShowNextFrame
           
            'Play ambient sounds
            Call RenderSounds
        End If
       
'TODO : Porque el pausado de 20 ms???
        If GetTickCount - LastTime > 20 Then
            If Not pausa And frmMain.Visible And Not frmForo.Visible And Not frmComerciar.Visible And Not frmComerciarUsu.Visible And Not frmBancoObj.Visible Then
                CheckKeys
                LastTime = GetTickCount
            End If
        End If
       
        'Limitamos los FPS a 18 (con el nuevo engine 60 es un número mucho mejor)
        While (GetTickCount - lFrameTimer) \ 56 < FramesPerSecCounter
            Sleep 5
        Wend
       
        'FPS Counter - mostramos las FPS
        If GetTickCount - lFrameTimer >= 1000 Then
            FramesPerSec = FramesPerSecCounter
           
            If FPSFLAG Then frmMain.Caption = FramesPerSec
           
            FramesPerSecCounter = 0
            lFrameTimer = GetTickCount
        End If
       
'TODO : Sería mejor comparar el tiempo desde la última vez que se hizo hasta el actual SOLO cuando se precisa. Además evitás el corte de intervalos con 2 golpes seguidos.
        'Sistema de timers renovado:
        esttick = GetTickCount
        For loopc = 1 To UBound(timers)
            timers(loopc) = timers(loopc) + (esttick - ulttick)
            'Timer de trabajo
            If timers(1) >= tUs Then
                timers(1) = 0
                NoPuedeUsar = False
            End If
            'timer de attaque (77)
            If timers(2) >= tAt Then
                timers(2) = 0
                UserCanAttack = 1
                UserPuedeRefrescar = True
            End If
        Next loopc
        ulttick = GetTickCount
       
#If SeguridadAlkon Then
        Call CheckSecurity
#End If
       
        DoEvents
    Loop
 
    EngineRun = False
    frmCargando.Show
    AddtoRichTextBox frmCargando.Status, "Liberando recursos...", 0, 0, 0, 0, 0, 1
    LiberarObjetosDX
 
'TODO : Esto debería ir en otro lado como al cambair a esta res
    If Not bNoResChange Then
        Dim typDevM As typDevMODE
        Dim lRes As Long
       
        lRes = EnumDisplaySettings(0, 0, typDevM)
        With typDevM
            .dmFields = DM_PELSWIDTH Or DM_PELSHEIGHT
            .dmPelsWidth = oldResWidth
            .dmPelsHeight = oldResHeight
        End With
        lRes = ChangeDisplaySettings(typDevM, CDS_TEST)
    End If
 
    'Destruimos los objetos públicos creados
    Set SurfaceDB = Nothing
    Set Dialogos = Nothing
    Set DialogosClanes = Nothing
    Set Audio = Nothing
    Set Inventario = Nothing
#If SeguridadAlkon Then
    Set md5 = Nothing
#End If
   
    Call UnloadAllForms
   
    'Actualizar tip
    Config_Inicio.tip = tipf
    Call EscribirGameIni(Config_Inicio)
   
#If SeguridadAlkon Then
    DeinitSecurity
#End If
End
 
ManejadorErrores:
    MsgBox "Ha ocurrido un error irreparable, el cliente se cerrará."
    LogError "Contexto:" & Err.HelpContext & " Desc:" & Err.Description & " Fuente:" & Err.source
    End
End Sub
 


y listo , ahi tendriamos nuestro Launcher Funcionando!

Ver perfil de usuario

2 ArreK el Vie Mayo 01, 2009 4:53 pm

ArreK


USUARIO REGISTRADO
Que lindo yo andava bucando uno Smile

Ver perfil de usuario

3 Sheker Hunder el Vie Mayo 01, 2009 7:58 pm

Sheker hunder


USUARIO REGISTRADO
Sisi yo Tmb..

Ver perfil de usuario

4 ArreK el Vie Mayo 01, 2009 9:51 pm

ArreK


USUARIO REGISTRADO
Pregunta:
El menu del launcher donde lo modigfico del mismo FRMAIN ???

Ver perfil de usuario

5 Re: [APORTE] Launcher 100% Funcional!! el Vie Mayo 08, 2009 12:07 pm

Guiido


SUPER MODERADOR
Me gusto Smile Suerte Very Happy

Ver perfil de usuario

Contenido patrocinado


Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.