[Hells] Login Diario [EO 2.0+]

Código:

Public DailyLogin(1 To 31) As DailyLoginRec

Código:

Public Type DailyLoginRec
    RewardItem As Long
    RewardValue As Long
End Type

Código:

Public Sub BltItemPic(ByVal itemNum As Long, ByRef picBox As VB.PictureBox, Optional ByVal Large As Byte = 1)
    Dim rec As RECT
    Dim rec_pos As RECT
    Dim itempic As Long, Form As VB.PictureBox
    
    itempic = Item(itemNum).pic
    
    If itempic <= 0 Then Exit Sub

    With rec
        .top = 0
        .Bottom = .top + PIC_Y '32
        .Left = 32 'DDSD_Item(itempic).lWidth / 2 '32
        .Right = .Left + PIC_X '64
    End With

    With rec_pos
        .top = 0
        .Bottom = .top + PIC_Y * Large '64 pra o dobro de tamanho
        .Left = 0
        .Right = .Left + PIC_X * Large
    End With
    
    ' Load item if not loaded, and reset timer
    ItemTimer(itempic) = GetTickCount + SurfaceTimerMax

    If DDS_Item(itempic) Is Nothing Then
        Call InitDDSurf("Items\" & itempic, DDSD_Item(itempic), DDS_Item(itempic))
    End If

    'frmSomeThing.picItemLeft1(2).Cls
    
    picBox.Cls
        
    Engine_BltToDC DDS_Item(itempic), rec, rec_pos, picBox, False
    
    'frmSomeThing.picItemLeft1(2).Refresh
    picBox.Refresh
End Sub

Código:

Public Sub SendDailyLogin()
    Dim buffer As clsBuffer

    ' If debug mode, handle error then exit out
    If Options.Debug = 1 Then On Error GoTo errorhandler

    Set buffer = New clsBuffer
    buffer.WriteLong CDailyLogin
    SendData buffer.ToArray()
    Set buffer = Nothing

    ' Error handler
    Exit Sub
errorhandler:
    HandleError "SendDailyLogin", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext
    Err.Clear
    Exit Sub
End Sub

Código:

Public DailyLogin(1 To 31) As DailyLoginRec

Public Type DailyLoginRec
    RewardItem As Long
    RewardValue As Long
End Type

Public Type DailyValueRec
    LoginDiario As Byte
    TentativasTorre As Byte
    TentativasDungeon As Byte
    TentativasInvasaoZ As Byte
    
    LastLoginDay As Byte
    LoginDay(1 To 31) As Byte
End Type

Código:

Sub SaveDayleValues(ByVal index As Long, ByVal Name As String, ByVal LoginDiario As Byte, ByVal TentativasTorre As Byte, ByVal TentativasDungeon As Byte, ByVal TentativasInvasaoZ As Byte)
    Dim fileName As String, JustCash As Long
    Dim F As Long, i As Byte

    fileName = App.Path & "\data\DayleValues\" & Trim$(Name) & ".bin"

    'Ponhar (255) pra anular
    If LoginDiario < 255 Then
        Call PutVar(fileName, Day(Now) & "/" & Month(Now) & "/" & Year(Now), "LoginDiario", STR(LoginDiario))
    End If
    
    Player(index).DailyValue.LoginDiario = GetVar(fileName, Day(Now) & "/" & Month(Now) & "/" & Year(Now), "LoginDiario")

End Sub

Sub CreateIPsActivity()
    Dim fileName As String
    Dim F As Long, i As Byte

    fileName = App.Path & "\data\IPsActivity\DailyLoginActivity\" & Day(Now) & "." & Month(Now) & "." & Year(Now) & ".bin"
    
    Call PutVar(fileName, "IPsActivity", "IPsToday", 0)
    'Call PutVar(fileName, "General", "ItemNum", STR(ItemNum))

End Sub

Sub SaveIPsActivity(ByVal IP As String)
    Dim fileName As String, IPsToday As Long
    Dim F As Long, i As Byte

    fileName = App.Path & "\data\IPsActivity\DailyLoginActivity\" & Day(Now) & "." & Month(Now) & "." & Year(Now) & ".bin"
    
    If Not FileExist(fileName, True) Then
        Call CreateIPsActivity
    End If
    
    IPsToday = GetVar(fileName, "IPsActivity", "IPsToday")
    
    Call PutVar(fileName, "IPsActivity", "IP" & IPsToday + 1, Trim$(IP))
    
    Call PutVar(fileName, "IPsActivity", "IPsToday", IPsToday + 1)

End Sub

Function CheckIPsActivity(ByVal IP As String) As Boolean
    Dim fileName As String, IPsToday As Long, IpToCheck As String
    Dim F As Long, i As Byte

    CheckIPsActivity = False

    fileName = App.Path & "\data\IPsActivity\DailyLoginActivity\" & Day(Now) & "." & Month(Now) & "." & Year(Now) & ".bin"
    
    If Not FileExist(fileName, True) Then
        Call CreateIPsActivity
    End If
    
    IPsToday = GetVar(fileName, "IPsActivity", "IPsToday")
    
    If IPsToday > 0 Then
    
        For i = 1 To IPsToday
        
            IpToCheck = GetVar(fileName, "IPsActivity", "IP" & i)
            
            If IpToCheck = IP Then
                CheckIPsActivity = True
            End If
        
        Next
    
    End If

End Function

Public Sub LoadDailyLogin()
    Dim fileName As String, i As Byte

    fileName = App.Path & "\data\dailyrewards.ini"

    If FileExist(fileName, True) Then
        For i = 1 To 31
            DailyLogin(i).RewardItem = GetVar(fileName, "DAILYREWARDS", "DayItem" & i)
            DailyLogin(i).RewardValue = Val(GetVar(fileName, "DAILYREWARDS", "DayValue" & i))
        Next i
    End If
End Sub


Código:

Call SetStatus("Carregando Daily Rewards...")
    Call LoadDailyLogin

Código:

HandleDataSub(CDailyLogin) = GetAddress(AddressOf HandleDailyLogin)
    HandleDataSub(CRequestDailyLogin) = GetAddress(AddressOf HandleRequestDailyLogin)

Código:

Public Sub HandleDailyLogin(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim fileName As String, i As Byte

    If CheckIPsActivity(GetPlayerIP(index)) = False Then
    
        If Player(index).Level < 100 Then
            PlayerMsg index, "Você precisa ser nivel 100+ para realizar login.", BrightRed
            Exit Sub
        End If
    
        If Player(index).DailyValue.LastLoginDay > Day(Now) Then
            For i = 1 To 31
                Player(index).DailyValue.LoginDay(i) = 0
            Next
        End If
'If GetPlayerName(index) = "Herleno" Then
'Player(index).DailyValue.LoginDay(Day(Now)) = 0
'end if
        If Player(index).DailyValue.LoginDay(Day(Now)) < 1 Then
            
            Player(index).DailyValue.LoginDay(Day(Now)) = 1
            Player(index).DailyValue.LastLoginDay = Day(Now)
            
            SaveDayleValues index, trim$(Player(index).name), 0, 3, 3, 3
            
            'For i = 1 To 10
            '    Player(index).DailyMission.Mission(i) = 0
            'Next
            
            GiveInvItem index, DailyLogin(Day(Now)).RewardItem, DailyLogin(Day(Now)).RewardValue, 0
            PlayerMsg index, "Você coletou " & Trim$(Item(DailyLogin(Day(Now)).RewardItem).Name) & " x" & DailyLogin(Day(Now)).RewardValue & " no login diario", Pink
            
            SaveIPsActivity GetPlayerIP(index)
            SavePlayer index
        Else
            PlayerMsg index, "Você ja coletou a recompensa de hoje, volte amanhã.", BrightRed
        End If
    Else
        PlayerMsg index, "Você ja coletou a recompensa de hoje, volte amanhã.", BrightRed
    End If
End Sub

Public Sub HandleRequestDailyLogin(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)
Dim i As Byte
    
    SendDailyLogin index
End Sub

Código:

Sub SendDailyLogin(ByVal index As Long)
    Dim Buffer As clsBuffer, i As Byte
    Set Buffer = New clsBuffer

    Buffer.WriteLong SSendDailyLogin
    For i = 1 To 31
        Buffer.WriteLong DailyLogin(i).RewardItem
        Buffer.WriteLong DailyLogin(i).RewardValue
        'Buffer.WriteLong Player(Index).DailyValue.LoginDay(i)
    Next
   
    SendDataTo index, Buffer.ToArray()
    Set Buffer = Nothing
End Sub

Gu1lh3rm3 escreveu:Se esta em construção, pra que postar assim então? kkk, não entendi

Kies escreveu:Acredito que esteja incompleto na parte do cliente, como adiciono itens e quando mostrei a frm da erro em SendDailyLogin fala que não foi definido. poderia completar por favor?