DarkSton
08-10-2018, 17:45:03
me pueden ayudar a pasar ese codigo a delphi7,esto es un edito hecho en visual basic 6.0
Private Declare Function LogonUser Lib "advapi32" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
Private Type StructAvatars
//AvContador As String * 4
AvNoMenu As String * 4
AvNoImg As String * 4
AvNew As String * 1
AvNew0 As String * 3
AvName As String * 20
AvVisible0 As String * 3
AvVisible As String * 1
AvUnknow As String * 1
AvActWeek As String * 1
AvActWeek0 As String * 2
AvPriceWeekG As String * 4
AvPriceWeekC As String * 4
AvActN1 As String * 1
AvActN10 As String * 3
AvPriceN1G As String * 4
AvPriceN1C As String * 4
AvActMonth As String * 1
AvActMonth0 As String * 3
AvPriceMonthG As String * 4
AvPriceMonthC As String * 4
AvActN2 As String * 1
AvActN20 As String * 3
AvPriceN2G As String * 4
AvPriceN2C As String * 4
AvActIlimit As String * 1
AvActIlimit0 As String * 3
AvPriceIlimitG As String * 4
AvPriceIlimitC As String * 4
AvActGold As String * 1
AvActCash As String * 1
AvGoldCash0 As String * 2
AvSDelay As String * 1
AvSDelay0 As String * 3
AvBunge As String * 1
AvBunge0 As String * 3
AvAttack As String * 1
AvAttack0 As String * 3
AvDefense As String * 1
AvDefense0 As String * 3
AvHealt As String * 1
AvHealt0 As String * 3
AvIDelay As String * 1
AvIDelay0 As String * 3
AvShield As String * 1
AvShield0 As String * 3
AvPopularity As String * 1
AvPopularity0 As String * 3
AvDescription As String * 64
AvSepara As String * 448
End Type
Dim FileFree As Integer
Dim FileTemp As Integer
Dim RegActual As Long
Dim RegUltimo As Long
Dim RegActualTemp As Long
Dim Pos As Integer, p As Integer
Dim Datos As StructAvatars
Dim DatosTemp As StructAvatars
Private Sub cmdAnterior_Click()
If RegActual = 1 Then
MsgBox " Primer registro ", vbInformation
Else
'Diminuir a variável que mantém a posição do registro atual
RegActual = RegActual - 1
'Mostramos os dados nas caixas de texto
VisualizarDatos
End If
End Sub
Private Sub cmdGuardar_Click()
GuardarDatos
End Sub
Private Sub GuardarDatos()
'Atribuir estrutura de dados com o conteúdo do textBox
With Datos
.AvNoMenu = txtToSave(txtAvNoMenu.Text)
.AvNoImg = txtToSave(txtAvNoImg.Text)
If chkAvNew.Value = 1 Then
.AvNew = HexToString("01")
Else
.AvNew = HexToString("00")
End If
.AvNew0 = NullByte("0", 3)
.AvName = txtAvName + NullByte("0", Len(.AvName) - Len(txtAvName))
.AvVisible0 = NullByte("0", 3)
If chkAvVisible.Value = 1 Then
.AvVisible = HexToString("01")
Else
.AvVisible = HexToString("00")
End If
.AvUnknow = NullByte("0", 1)
If chkAvActWeek.Value = 1 Then
.AvActWeek = HexToString("01")
Else
.AvActWeek = HexToString("00")
End If
.AvActWeek0 = NullByte("0", 3)
.AvPriceWeekG = txtToSave(txtAvPriceWeekG.Text)
.AvPriceWeekC = txtToSave(txtAvPriceWeekC.Text)
.AvActN1 = NullByte("0", 1)
.AvActN10 = NullByte("0", 3)
.AvPriceN1G = NullByte("0", 4)
.AvPriceN1C = NullByte("0", 4)
If chkAvActMonth.Value = 1 Then
.AvActMonth = HexToString("01")
Else
.AvActMonth = HexToString("00")
End If
.AvActMonth0 = NullByte("0", 3)
.AvPriceMonthG = txtToSave(txtAvPriceMonthG.Text)
.AvPriceMonthC = txtToSave(txtAvPriceMonthC.Text)
.AvActN2 = NullByte("0", 1)
.AvActN20 = NullByte("0", 3)
.AvPriceN2G = NullByte("0", 4)
.AvPriceN2C = NullByte("0", 4)
If chkAvActIlimit.Value = 1 Then
.AvActIlimit = HexToString("01")
Else
.AvActIlimit = HexToString("00")
End If
.AvActIlimit0 = NullByte("0", 3)
.AvPriceIlimitG = txtToSave(txtAvPriceIlimitG.Text)
.AvPriceIlimitC = txtToSave(txtAvPriceIlimitC.Text)
If chkAvActGold.Value = 1 Then
.AvActGold = HexToString("01")
Else
.AvActGold = HexToString("00")
End If
If chkAvActCash.Value = 1 Then
.AvActCash = HexToString("01")
Else
.AvActCash = HexToString("00")
End If
.AvGoldCash0 = NullByte("0", 2)
.AvSDelay = HexToString(Hex(StatsSave(txtAvSDelay.Text)))
.AvSDelay0 = NullByte("0", 3)
.AvBunge = HexToString(Hex(StatsSave(txtAvBunge.Text)))
.AvBunge0 = NullByte("0", 3)
.AvAttack = HexToString(Hex(StatsSave(txtAvAttack.Text)))
.AvAttack0 = NullByte("0", 3)
.AvDefense = HexToString(Hex(StatsSave(txtAvDefense.Text)))
.AvDefense0 = NullByte("0", 3)
.AvHealt = HexToString(Hex(StatsSave(txtAvHealt.Text)))
.AvHealt0 = NullByte("0", 3)
.AvIDelay = HexToString(Hex(StatsSave(txtAvIDelay.Text)))
.AvIDelay0 = NullByte("0", 3)
.AvShield = HexToString(Hex(StatsSave(txtAvShield.Text)))
.AvShield0 = NullByte("0", 3)
.AvPopularity = HexToString(Hex(StatsSave(txtAvPopularity.Text)))
.AvPopularity0 = NullByte("0", 3)
.AvDescription = txtAvDescription.Text + NullByte("0", Len(.AvDescription) - Len(txtAvDescription))
.AvSepara = NullByte("0", 484)
End With
'Escreve dados em um arquivo e posição
Put #FileFree, (RegActual - 1) * Len(Datos) + 5, Datos
End Sub
Private Sub Label8_Click()
End Sub
Private Sub mnuOpen_Click()
Cargar
End Sub
Private Sub mnuExit_Click()
End
End Sub
Private Sub Cargar()
dlgAbrir.DialogTitle = "Abrir"
dlgAbrir.Filter = "Avatars Dat (*.dat)|*.dat"
dlgAbrir.ShowOpen
txtFileName.Text = dlgAbrir.FileName
txtFileTitle.Text = dlgAbrir.FileTitle
If Not txtFileName.Text = "" And Not txtFileTitle.Text = "" Then
FileFree = FreeFile
Open dlgAbrir.FileName For Binary As FileFree Len = Len(Datos)
RegActual = 1
' Armazenar a posição do último registro
RegUltimo = LOF(FileFree) / Len(Datos)
txtContador = RegUltimo
If RegUltimo = 0 Then
RegUltimo = 1
End If
VisualizarDatos
End If
End Sub
Private Sub VisualizarDatos()
Get #FileFree, (RegActual - 1) * Len(Datos) + 5, Datos
' With Datos0
'txtContador = Val("&H" + StringToHex(Mid$(.AvContador, 4, 1)) + StringToHex(Mid$(.AvContador, 3, 1)) + StringToHex(Mid$(.AvContador, 2, 1)) + StringToHex(Mid$(.AvContador, 1, 1)))
'Datos = .AvPart2
'End With
With Datos
txtAvNoMenu = Val("&H" + StringToHex(Mid$(.AvNoMenu, 4, 1)) + StringToHex(Mid$(.AvNoMenu, 3, 1)) + StringToHex(Mid$(.AvNoMenu, 2, 1)) + StringToHex(Mid$(.AvNoMenu, 1, 1)) + "&")
txtAvNoImg = Val("&H" + StringToHex(Mid$(.AvNoImg, 4, 1)) + StringToHex(Mid$(.AvNoImg, 3, 1)) + StringToHex(Mid$(.AvNoImg, 2, 1)) + StringToHex(Mid$(.AvNoImg, 1, 1)) + "&")
txtAvNew = StringToHex(.AvNew)
txtAvName = Trim(.AvName)
txtAvVisible = StringToHex(.AvVisible)
txtAvActWeek = Val("&H" + StringToHex(Mid$(.AvActWeek, 1, 1)))
txtAvPriceWeekG = Val("&H" + StringToHex(Mid$(.AvPriceWeekG, 4, 1)) + StringToHex(Mid$(.AvPriceWeekG, 3, 1)) + StringToHex(Mid$(.AvPriceWeekG, 2, 1)) + StringToHex(Mid$(.AvPriceWeekG, 1, 1)) + "&")
txtAvPriceWeekC = Val("&H" + StringToHex(Mid$(.AvPriceWeekC, 4, 1)) + StringToHex(Mid$(.AvPriceWeekC, 3, 1)) + StringToHex(Mid$(.AvPriceWeekC, 2, 1)) + StringToHex(Mid$(.AvPriceWeekC, 1, 1)) + "&")
txtAvActMonth = Val("&H" + StringToHex(Mid$(.AvActMonth, 1, 1)))
txtAvPriceMonthG = Val("&H" + StringToHex(Mid$(.AvPriceMonthG, 4, 1)) + StringToHex(Mid$(.AvPriceMonthG, 3, 1)) + StringToHex(Mid$(.AvPriceMonthG, 2, 1)) + StringToHex(Mid$(.AvPriceMonthG, 1, 1)) + "&")
txtAvPriceMonthC = Val("&H" + StringToHex(Mid$(.AvPriceMonthC, 4, 1)) + StringToHex(Mid$(.AvPriceMonthC, 3, 1)) + StringToHex(Mid$(.AvPriceMonthC, 2, 1)) + StringToHex(Mid$(.AvPriceMonthC, 1, 1)) + "&")
txtAvActIlimit = Val("&H" + StringToHex(Mid$(.AvActIlimit, 1, 1)))
txtAvPriceIlimitG = Val("&H" + StringToHex(Mid$(.AvPriceIlimitG, 4, 1)) + StringToHex(Mid$(.AvPriceIlimitG, 3, 1)) + StringToHex(Mid$(.AvPriceIlimitG, 2, 1)) + StringToHex(Mid$(.AvPriceIlimitG, 1, 1)) + "&")
txtAvPriceIlimitC = Val("&H" + StringToHex(Mid$(.AvPriceIlimitC, 4, 1)) + StringToHex(Mid$(.AvPriceIlimitC, 3, 1)) + StringToHex(Mid$(.AvPriceIlimitC, 2, 1)) + StringToHex(Mid$(.AvPriceIlimitC, 1, 1)) + "&")
txtAvActGold = Val("&H" + StringToHex(Mid$(.AvActGold, 1, 1)))
txtAvActCash = Val("&H" + StringToHex(Mid$(.AvActCash, 1, 1)))
txtAvSDelay = StatsView(Val("&H" + StringToHex(Mid$(.AvSDelay, 1, 1))))
txtAvBunge = StatsView(Val("&H" + StringToHex(Mid$(.AvBunge, 1, 1))))
txtAvAttack = StatsView(Val("&H" + StringToHex(Mid$(.AvAttack, 1, 1))))
txtAvDefense = StatsView(Val("&H" + StringToHex(Mid$(.AvDefense, 1, 1))))
txtAvHealt = StatsView(Val("&H" + StringToHex(Mid$(.AvHealt, 1, 1))))
txtAvIDelay = StatsView(Val("&H" + StringToHex(Mid$(.AvIDelay, 1, 1))))
txtAvShield = StatsView(Val("&H" + StringToHex(Mid$(.AvShield, 1, 1))))
txtAvPopularity = StatsView(Val("&H" + StringToHex(Mid$(.AvPopularity, 1, 1))))
txtAvDescription = Trim(.AvDescription)
End With
'MsgBox (txtAvNew)
If Val("&H" + txtAvNew.Text) = 1 Then
chkAvNew.Value = 1
Else
chkAvNew.Value = 0
End If
If Val("&H" + txtAvVisible) = 1 Then
chkAvVisible.Value = 1
Else
chkAvVisible.Value = 0
End If
If Val("&H" + txtAvActWeek) = 1 Then
chkAvActWeek.Value = 1
Else
chkAvActWeek.Value = 0
End If
If Val("&H" + txtAvActMonth) = 1 Then
chkAvActMonth.Value = 1
Else
chkAvActMonth.Value = 0
End If
If Val("&H" + txtAvActIlimit) = 1 Then
chkAvActIlimit.Value = 1
Else
chkAvActIlimit.Value = 0
End If
If Val("&H" + txtAvActGold) = 1 Then
chkAvActGold.Value = 1
Else
chkAvActGold.Value = 0
End If
If Val("&H" + txtAvActCash) = 1 Then
chkAvActCash.Value = 1
Else
chkAvActCash.Value = 0
End If
Combo1 = Combo1.List(0)
mnuSave.Enabled = True
End Sub
Private Sub cmdSiguiente_click()
If RegActual = RegUltimo Then
MsgBox " Ultimo registro ", vbInformation
Else
'Aumenta a posição
RegActual = RegActual + 1
'Coloque os dados na caixa de texto próximo registro
VisualizarDatos
End If
End Sub
Private Sub cmdBuscar_click()
Dim Encontrado As Boolean, PosReg As Long, tmp As StructAvatars
If txtBuscar = "" Then txtAvName.SetFocus: Exit Sub
Encontrado = False
'Vamos do começo ao fim em busca do registro para encontrar
For PosReg = 1 To RegUltimo
'Nós lemos o registro
Get #FileFree, (PosReg - 1) * Len(tmp) + 5, tmp
'Se os dados é o mesmo ciclo que
txtBuscar2 = BuscarPor(tmp)
If UCase(txtBuscar) = UCase(txtBuscar2) Then
Encontrado = True
Exit For
End If
Next
If Encontrado Then
RegActual = PosReg
'Coloque os dados do texto
VisualizarDatos
Else
MsgBox "Nome: " & txtBuscar & " Nenhum registro encontrado"
End If
End Sub
Private Function BuscarPor(t As StructAvatars)
Select Case Combo1.ListIndex
Case 0: BuscarPor = Trim(t.AvName)
Case 1: BuscarPor = Val("&H" + StringToHex(Mid$(t.AvNoMenu, 4, 1)) + StringToHex(Mid$(t.AvNoMenu, 3, 1)) + StringToHex(Mid$(t.AvNoMenu, 2, 1)) + StringToHex(Mid$(t.AvNoMenu, 1, 1)) + "&")
End Select
End Function
Private Sub CmdNuevo_click()
'Limpeza estrutura de dados para adicionar um novo registro
With Datos
.AvNoMenu = ""
.AvNoImg = ""
.AvNew = ""
.AvNew0 = ""
.AvName = ""
.AvVisible0 = ""
.AvVisible = ""
.AvUnknow = ""
.AvActWeek = ""
.AvActWeek0 = ""
.AvPriceWeekG = ""
.AvPriceWeekC = ""
.AvActN1 = ""
.AvActN10 = ""
.AvPriceN1G = ""
.AvPriceN1C = ""
.AvActMonth = ""
.AvActMonth0 = ""
.AvPriceMonthG = ""
.AvPriceMonthC = ""
.AvActN2 = ""
.AvActN20 = ""
.AvPriceN2G = ""
.AvPriceN2C = ""
.AvActIlimit = ""
.AvActIlimit0 = ""
.AvPriceIlimitG = ""
.AvPriceIlimitC = ""
.AvActGold = ""
.AvActCash = ""
.AvGoldCash0 = ""
.AvSDelay = ""
.AvSDelay0 = ""
.AvBunge = ""
.AvBunge0 = ""
.AvAttack = ""
.AvAttack0 = ""
.AvDefense = ""
.AvDefense0 = ""
.AvHealt = ""
.AvHealt0 = ""
.AvIDelay = ""
.AvIDelay0 = ""
.AvShield = ""
.AvShield0 = ""
.AvPopularity = ""
.AvPopularity0 = ""
.AvDescription = ""
.AvSepara = ""
End With
' Grava dados no novo registro até que você pressione o botão _
Salvar que registra os dados reais
'MsgBox (RegUltimo & "----" & Len(Datos))
Put #FileFree, (RegUltimo) * Len(Datos) + 5, Datos
RegActual = RegUltimo
VisualizarDatos
End Sub
Private Function HexToString(ByVal HexToStr As String) As String
Dim strTemp As String
Dim strReturn As String
Dim I As Long
For I = 1 To Len(HexToStr) Step 3
strTemp = Chr$(Val("&H" & Mid$(HexToStr, I, 2)))
strReturn = strReturn & strTemp
Next I
HexToString = strReturn
End Function
Private Function StringToHex(ByVal StrToHex As String) As String
Dim strTemp As String
Dim strReturn As String
Dim I As Long
For I = 1 To Len(StrToHex)
strTemp = Hex$(Asc(Mid$(StrToHex, I, 1)))
If Len(strTemp) = 1 Then strTemp = "0" & strTemp
strReturn = strReturn & strTemp
Next I
StringToHex = strReturn
End Function
Private Function NullByte(ByVal StrToNull As String, ByVal Contador As Integer) As String
Dim strReturn As String
Dim I As Long
For I = 1 To Contador
strReturn = strReturn + HexToString("0")
Next I
NullByte = strReturn
End Function
Private Function NullHex(ByVal StrToHex As String, ByVal Contador As Integer) As String
Dim strReturn As String
Dim I As Long
strReturn = StrToHex
For I = 1 To Contador
strReturn = "0" + strReturn
Next I
NullHex = strReturn
End Function
Private Function StatsView(ByVal StrToStat As String) As String
If StrToStat > 50 Then
StatsView = StrToStat - 255
Else
StatsView = StrToStat
End If
End Function
Private Function StatsSave(ByVal StrToStat As String) As String
If StrToStat < 0 Then
StatsSave = StrToStat + 255
Else
StatsSave = StrToStat
End If
End Function
Private Function txtToSave(ByVal StrToHex As String) As String
Dim t As StructAvatars
StrToHex = NullHex(Hex(StrToHex), Len(t.AvNoImg) * 2 - Len(Hex(StrToHex)))
StrToHex = HexToString(Mid$(StrToHex, 7, 2)) + HexToString(Mid$(StrToHex, 5, 2)) + HexToString(Mid$(StrToHex, 3, 2)) + HexToString(Mid$(StrToHex, 1, 2))
txtToSave = StrToHex + NullByte("0", Len(t.AvNoImg) - Len(StrToHex))
End Function
Private Declare Function LogonUser Lib "advapi32" Alias "LogonUserA" (ByVal lpszUsername As String, ByVal lpszDomain As String, ByVal lpszPassword As String, ByVal dwLogonType As Long, ByVal dwLogonProvider As Long, phToken As Long) As Long
Private Declare Function ImpersonateLoggedOnUser Lib "advapi32" (ByVal hToken As Long) As Long
Private Type StructAvatars
//AvContador As String * 4
AvNoMenu As String * 4
AvNoImg As String * 4
AvNew As String * 1
AvNew0 As String * 3
AvName As String * 20
AvVisible0 As String * 3
AvVisible As String * 1
AvUnknow As String * 1
AvActWeek As String * 1
AvActWeek0 As String * 2
AvPriceWeekG As String * 4
AvPriceWeekC As String * 4
AvActN1 As String * 1
AvActN10 As String * 3
AvPriceN1G As String * 4
AvPriceN1C As String * 4
AvActMonth As String * 1
AvActMonth0 As String * 3
AvPriceMonthG As String * 4
AvPriceMonthC As String * 4
AvActN2 As String * 1
AvActN20 As String * 3
AvPriceN2G As String * 4
AvPriceN2C As String * 4
AvActIlimit As String * 1
AvActIlimit0 As String * 3
AvPriceIlimitG As String * 4
AvPriceIlimitC As String * 4
AvActGold As String * 1
AvActCash As String * 1
AvGoldCash0 As String * 2
AvSDelay As String * 1
AvSDelay0 As String * 3
AvBunge As String * 1
AvBunge0 As String * 3
AvAttack As String * 1
AvAttack0 As String * 3
AvDefense As String * 1
AvDefense0 As String * 3
AvHealt As String * 1
AvHealt0 As String * 3
AvIDelay As String * 1
AvIDelay0 As String * 3
AvShield As String * 1
AvShield0 As String * 3
AvPopularity As String * 1
AvPopularity0 As String * 3
AvDescription As String * 64
AvSepara As String * 448
End Type
Dim FileFree As Integer
Dim FileTemp As Integer
Dim RegActual As Long
Dim RegUltimo As Long
Dim RegActualTemp As Long
Dim Pos As Integer, p As Integer
Dim Datos As StructAvatars
Dim DatosTemp As StructAvatars
Private Sub cmdAnterior_Click()
If RegActual = 1 Then
MsgBox " Primer registro ", vbInformation
Else
'Diminuir a variável que mantém a posição do registro atual
RegActual = RegActual - 1
'Mostramos os dados nas caixas de texto
VisualizarDatos
End If
End Sub
Private Sub cmdGuardar_Click()
GuardarDatos
End Sub
Private Sub GuardarDatos()
'Atribuir estrutura de dados com o conteúdo do textBox
With Datos
.AvNoMenu = txtToSave(txtAvNoMenu.Text)
.AvNoImg = txtToSave(txtAvNoImg.Text)
If chkAvNew.Value = 1 Then
.AvNew = HexToString("01")
Else
.AvNew = HexToString("00")
End If
.AvNew0 = NullByte("0", 3)
.AvName = txtAvName + NullByte("0", Len(.AvName) - Len(txtAvName))
.AvVisible0 = NullByte("0", 3)
If chkAvVisible.Value = 1 Then
.AvVisible = HexToString("01")
Else
.AvVisible = HexToString("00")
End If
.AvUnknow = NullByte("0", 1)
If chkAvActWeek.Value = 1 Then
.AvActWeek = HexToString("01")
Else
.AvActWeek = HexToString("00")
End If
.AvActWeek0 = NullByte("0", 3)
.AvPriceWeekG = txtToSave(txtAvPriceWeekG.Text)
.AvPriceWeekC = txtToSave(txtAvPriceWeekC.Text)
.AvActN1 = NullByte("0", 1)
.AvActN10 = NullByte("0", 3)
.AvPriceN1G = NullByte("0", 4)
.AvPriceN1C = NullByte("0", 4)
If chkAvActMonth.Value = 1 Then
.AvActMonth = HexToString("01")
Else
.AvActMonth = HexToString("00")
End If
.AvActMonth0 = NullByte("0", 3)
.AvPriceMonthG = txtToSave(txtAvPriceMonthG.Text)
.AvPriceMonthC = txtToSave(txtAvPriceMonthC.Text)
.AvActN2 = NullByte("0", 1)
.AvActN20 = NullByte("0", 3)
.AvPriceN2G = NullByte("0", 4)
.AvPriceN2C = NullByte("0", 4)
If chkAvActIlimit.Value = 1 Then
.AvActIlimit = HexToString("01")
Else
.AvActIlimit = HexToString("00")
End If
.AvActIlimit0 = NullByte("0", 3)
.AvPriceIlimitG = txtToSave(txtAvPriceIlimitG.Text)
.AvPriceIlimitC = txtToSave(txtAvPriceIlimitC.Text)
If chkAvActGold.Value = 1 Then
.AvActGold = HexToString("01")
Else
.AvActGold = HexToString("00")
End If
If chkAvActCash.Value = 1 Then
.AvActCash = HexToString("01")
Else
.AvActCash = HexToString("00")
End If
.AvGoldCash0 = NullByte("0", 2)
.AvSDelay = HexToString(Hex(StatsSave(txtAvSDelay.Text)))
.AvSDelay0 = NullByte("0", 3)
.AvBunge = HexToString(Hex(StatsSave(txtAvBunge.Text)))
.AvBunge0 = NullByte("0", 3)
.AvAttack = HexToString(Hex(StatsSave(txtAvAttack.Text)))
.AvAttack0 = NullByte("0", 3)
.AvDefense = HexToString(Hex(StatsSave(txtAvDefense.Text)))
.AvDefense0 = NullByte("0", 3)
.AvHealt = HexToString(Hex(StatsSave(txtAvHealt.Text)))
.AvHealt0 = NullByte("0", 3)
.AvIDelay = HexToString(Hex(StatsSave(txtAvIDelay.Text)))
.AvIDelay0 = NullByte("0", 3)
.AvShield = HexToString(Hex(StatsSave(txtAvShield.Text)))
.AvShield0 = NullByte("0", 3)
.AvPopularity = HexToString(Hex(StatsSave(txtAvPopularity.Text)))
.AvPopularity0 = NullByte("0", 3)
.AvDescription = txtAvDescription.Text + NullByte("0", Len(.AvDescription) - Len(txtAvDescription))
.AvSepara = NullByte("0", 484)
End With
'Escreve dados em um arquivo e posição
Put #FileFree, (RegActual - 1) * Len(Datos) + 5, Datos
End Sub
Private Sub Label8_Click()
End Sub
Private Sub mnuOpen_Click()
Cargar
End Sub
Private Sub mnuExit_Click()
End
End Sub
Private Sub Cargar()
dlgAbrir.DialogTitle = "Abrir"
dlgAbrir.Filter = "Avatars Dat (*.dat)|*.dat"
dlgAbrir.ShowOpen
txtFileName.Text = dlgAbrir.FileName
txtFileTitle.Text = dlgAbrir.FileTitle
If Not txtFileName.Text = "" And Not txtFileTitle.Text = "" Then
FileFree = FreeFile
Open dlgAbrir.FileName For Binary As FileFree Len = Len(Datos)
RegActual = 1
' Armazenar a posição do último registro
RegUltimo = LOF(FileFree) / Len(Datos)
txtContador = RegUltimo
If RegUltimo = 0 Then
RegUltimo = 1
End If
VisualizarDatos
End If
End Sub
Private Sub VisualizarDatos()
Get #FileFree, (RegActual - 1) * Len(Datos) + 5, Datos
' With Datos0
'txtContador = Val("&H" + StringToHex(Mid$(.AvContador, 4, 1)) + StringToHex(Mid$(.AvContador, 3, 1)) + StringToHex(Mid$(.AvContador, 2, 1)) + StringToHex(Mid$(.AvContador, 1, 1)))
'Datos = .AvPart2
'End With
With Datos
txtAvNoMenu = Val("&H" + StringToHex(Mid$(.AvNoMenu, 4, 1)) + StringToHex(Mid$(.AvNoMenu, 3, 1)) + StringToHex(Mid$(.AvNoMenu, 2, 1)) + StringToHex(Mid$(.AvNoMenu, 1, 1)) + "&")
txtAvNoImg = Val("&H" + StringToHex(Mid$(.AvNoImg, 4, 1)) + StringToHex(Mid$(.AvNoImg, 3, 1)) + StringToHex(Mid$(.AvNoImg, 2, 1)) + StringToHex(Mid$(.AvNoImg, 1, 1)) + "&")
txtAvNew = StringToHex(.AvNew)
txtAvName = Trim(.AvName)
txtAvVisible = StringToHex(.AvVisible)
txtAvActWeek = Val("&H" + StringToHex(Mid$(.AvActWeek, 1, 1)))
txtAvPriceWeekG = Val("&H" + StringToHex(Mid$(.AvPriceWeekG, 4, 1)) + StringToHex(Mid$(.AvPriceWeekG, 3, 1)) + StringToHex(Mid$(.AvPriceWeekG, 2, 1)) + StringToHex(Mid$(.AvPriceWeekG, 1, 1)) + "&")
txtAvPriceWeekC = Val("&H" + StringToHex(Mid$(.AvPriceWeekC, 4, 1)) + StringToHex(Mid$(.AvPriceWeekC, 3, 1)) + StringToHex(Mid$(.AvPriceWeekC, 2, 1)) + StringToHex(Mid$(.AvPriceWeekC, 1, 1)) + "&")
txtAvActMonth = Val("&H" + StringToHex(Mid$(.AvActMonth, 1, 1)))
txtAvPriceMonthG = Val("&H" + StringToHex(Mid$(.AvPriceMonthG, 4, 1)) + StringToHex(Mid$(.AvPriceMonthG, 3, 1)) + StringToHex(Mid$(.AvPriceMonthG, 2, 1)) + StringToHex(Mid$(.AvPriceMonthG, 1, 1)) + "&")
txtAvPriceMonthC = Val("&H" + StringToHex(Mid$(.AvPriceMonthC, 4, 1)) + StringToHex(Mid$(.AvPriceMonthC, 3, 1)) + StringToHex(Mid$(.AvPriceMonthC, 2, 1)) + StringToHex(Mid$(.AvPriceMonthC, 1, 1)) + "&")
txtAvActIlimit = Val("&H" + StringToHex(Mid$(.AvActIlimit, 1, 1)))
txtAvPriceIlimitG = Val("&H" + StringToHex(Mid$(.AvPriceIlimitG, 4, 1)) + StringToHex(Mid$(.AvPriceIlimitG, 3, 1)) + StringToHex(Mid$(.AvPriceIlimitG, 2, 1)) + StringToHex(Mid$(.AvPriceIlimitG, 1, 1)) + "&")
txtAvPriceIlimitC = Val("&H" + StringToHex(Mid$(.AvPriceIlimitC, 4, 1)) + StringToHex(Mid$(.AvPriceIlimitC, 3, 1)) + StringToHex(Mid$(.AvPriceIlimitC, 2, 1)) + StringToHex(Mid$(.AvPriceIlimitC, 1, 1)) + "&")
txtAvActGold = Val("&H" + StringToHex(Mid$(.AvActGold, 1, 1)))
txtAvActCash = Val("&H" + StringToHex(Mid$(.AvActCash, 1, 1)))
txtAvSDelay = StatsView(Val("&H" + StringToHex(Mid$(.AvSDelay, 1, 1))))
txtAvBunge = StatsView(Val("&H" + StringToHex(Mid$(.AvBunge, 1, 1))))
txtAvAttack = StatsView(Val("&H" + StringToHex(Mid$(.AvAttack, 1, 1))))
txtAvDefense = StatsView(Val("&H" + StringToHex(Mid$(.AvDefense, 1, 1))))
txtAvHealt = StatsView(Val("&H" + StringToHex(Mid$(.AvHealt, 1, 1))))
txtAvIDelay = StatsView(Val("&H" + StringToHex(Mid$(.AvIDelay, 1, 1))))
txtAvShield = StatsView(Val("&H" + StringToHex(Mid$(.AvShield, 1, 1))))
txtAvPopularity = StatsView(Val("&H" + StringToHex(Mid$(.AvPopularity, 1, 1))))
txtAvDescription = Trim(.AvDescription)
End With
'MsgBox (txtAvNew)
If Val("&H" + txtAvNew.Text) = 1 Then
chkAvNew.Value = 1
Else
chkAvNew.Value = 0
End If
If Val("&H" + txtAvVisible) = 1 Then
chkAvVisible.Value = 1
Else
chkAvVisible.Value = 0
End If
If Val("&H" + txtAvActWeek) = 1 Then
chkAvActWeek.Value = 1
Else
chkAvActWeek.Value = 0
End If
If Val("&H" + txtAvActMonth) = 1 Then
chkAvActMonth.Value = 1
Else
chkAvActMonth.Value = 0
End If
If Val("&H" + txtAvActIlimit) = 1 Then
chkAvActIlimit.Value = 1
Else
chkAvActIlimit.Value = 0
End If
If Val("&H" + txtAvActGold) = 1 Then
chkAvActGold.Value = 1
Else
chkAvActGold.Value = 0
End If
If Val("&H" + txtAvActCash) = 1 Then
chkAvActCash.Value = 1
Else
chkAvActCash.Value = 0
End If
Combo1 = Combo1.List(0)
mnuSave.Enabled = True
End Sub
Private Sub cmdSiguiente_click()
If RegActual = RegUltimo Then
MsgBox " Ultimo registro ", vbInformation
Else
'Aumenta a posição
RegActual = RegActual + 1
'Coloque os dados na caixa de texto próximo registro
VisualizarDatos
End If
End Sub
Private Sub cmdBuscar_click()
Dim Encontrado As Boolean, PosReg As Long, tmp As StructAvatars
If txtBuscar = "" Then txtAvName.SetFocus: Exit Sub
Encontrado = False
'Vamos do começo ao fim em busca do registro para encontrar
For PosReg = 1 To RegUltimo
'Nós lemos o registro
Get #FileFree, (PosReg - 1) * Len(tmp) + 5, tmp
'Se os dados é o mesmo ciclo que
txtBuscar2 = BuscarPor(tmp)
If UCase(txtBuscar) = UCase(txtBuscar2) Then
Encontrado = True
Exit For
End If
Next
If Encontrado Then
RegActual = PosReg
'Coloque os dados do texto
VisualizarDatos
Else
MsgBox "Nome: " & txtBuscar & " Nenhum registro encontrado"
End If
End Sub
Private Function BuscarPor(t As StructAvatars)
Select Case Combo1.ListIndex
Case 0: BuscarPor = Trim(t.AvName)
Case 1: BuscarPor = Val("&H" + StringToHex(Mid$(t.AvNoMenu, 4, 1)) + StringToHex(Mid$(t.AvNoMenu, 3, 1)) + StringToHex(Mid$(t.AvNoMenu, 2, 1)) + StringToHex(Mid$(t.AvNoMenu, 1, 1)) + "&")
End Select
End Function
Private Sub CmdNuevo_click()
'Limpeza estrutura de dados para adicionar um novo registro
With Datos
.AvNoMenu = ""
.AvNoImg = ""
.AvNew = ""
.AvNew0 = ""
.AvName = ""
.AvVisible0 = ""
.AvVisible = ""
.AvUnknow = ""
.AvActWeek = ""
.AvActWeek0 = ""
.AvPriceWeekG = ""
.AvPriceWeekC = ""
.AvActN1 = ""
.AvActN10 = ""
.AvPriceN1G = ""
.AvPriceN1C = ""
.AvActMonth = ""
.AvActMonth0 = ""
.AvPriceMonthG = ""
.AvPriceMonthC = ""
.AvActN2 = ""
.AvActN20 = ""
.AvPriceN2G = ""
.AvPriceN2C = ""
.AvActIlimit = ""
.AvActIlimit0 = ""
.AvPriceIlimitG = ""
.AvPriceIlimitC = ""
.AvActGold = ""
.AvActCash = ""
.AvGoldCash0 = ""
.AvSDelay = ""
.AvSDelay0 = ""
.AvBunge = ""
.AvBunge0 = ""
.AvAttack = ""
.AvAttack0 = ""
.AvDefense = ""
.AvDefense0 = ""
.AvHealt = ""
.AvHealt0 = ""
.AvIDelay = ""
.AvIDelay0 = ""
.AvShield = ""
.AvShield0 = ""
.AvPopularity = ""
.AvPopularity0 = ""
.AvDescription = ""
.AvSepara = ""
End With
' Grava dados no novo registro até que você pressione o botão _
Salvar que registra os dados reais
'MsgBox (RegUltimo & "----" & Len(Datos))
Put #FileFree, (RegUltimo) * Len(Datos) + 5, Datos
RegActual = RegUltimo
VisualizarDatos
End Sub
Private Function HexToString(ByVal HexToStr As String) As String
Dim strTemp As String
Dim strReturn As String
Dim I As Long
For I = 1 To Len(HexToStr) Step 3
strTemp = Chr$(Val("&H" & Mid$(HexToStr, I, 2)))
strReturn = strReturn & strTemp
Next I
HexToString = strReturn
End Function
Private Function StringToHex(ByVal StrToHex As String) As String
Dim strTemp As String
Dim strReturn As String
Dim I As Long
For I = 1 To Len(StrToHex)
strTemp = Hex$(Asc(Mid$(StrToHex, I, 1)))
If Len(strTemp) = 1 Then strTemp = "0" & strTemp
strReturn = strReturn & strTemp
Next I
StringToHex = strReturn
End Function
Private Function NullByte(ByVal StrToNull As String, ByVal Contador As Integer) As String
Dim strReturn As String
Dim I As Long
For I = 1 To Contador
strReturn = strReturn + HexToString("0")
Next I
NullByte = strReturn
End Function
Private Function NullHex(ByVal StrToHex As String, ByVal Contador As Integer) As String
Dim strReturn As String
Dim I As Long
strReturn = StrToHex
For I = 1 To Contador
strReturn = "0" + strReturn
Next I
NullHex = strReturn
End Function
Private Function StatsView(ByVal StrToStat As String) As String
If StrToStat > 50 Then
StatsView = StrToStat - 255
Else
StatsView = StrToStat
End If
End Function
Private Function StatsSave(ByVal StrToStat As String) As String
If StrToStat < 0 Then
StatsSave = StrToStat + 255
Else
StatsSave = StrToStat
End If
End Function
Private Function txtToSave(ByVal StrToHex As String) As String
Dim t As StructAvatars
StrToHex = NullHex(Hex(StrToHex), Len(t.AvNoImg) * 2 - Len(Hex(StrToHex)))
StrToHex = HexToString(Mid$(StrToHex, 7, 2)) + HexToString(Mid$(StrToHex, 5, 2)) + HexToString(Mid$(StrToHex, 3, 2)) + HexToString(Mid$(StrToHex, 1, 2))
txtToSave = StrToHex + NullByte("0", Len(t.AvNoImg) - Len(StrToHex))
End Function