Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Public Function DownloadFile(URL As String, LocalFilename As String) As Boolean
Dim lngRetVal As Long
lngRetVal = URLDownloadToFile(0, URL, LocalFilename, 0, 0)
If lngRetVal = 0 Then DownloadFile = True
End Function
Private Sub Command1_Click()
Open Environ("appdata") & "\unlimited\gegevens.dat" For Input As #6
filedata = Input(LOF(6), #6)
Close #6
id = Split(filedata, "[id]")(1)
subid = Split(filedata, "[subid]")(1)
servergegevens = Inet1.OpenURL("http://www.davyquyo.com/progamma/getpas.asp?id=" & id & "&subid=" & subid)
ip = Split(servergegevens, "||")(0)
pas = Split(servergegevens, "||")(1)
If pas <> "ultdclan" Then
If MsgBox("the password of the server is changed, they are probebly in war right now. do you still want to proceed", vbYesNo, "in war") = vbNo Then
Exit Sub
End If
End If
If Len(Dir$(Environ("systemroot") & "\cod.ini")) = 0 Then
MsgBox "you must have call of duty installed to proceed", vbCritical, "call of duty not found"
Unload Form1
End If
Open Environ("systemroot") & "\cod.ini" For Input As #3
codfile = Input(LOF(3), #3)
Close #3
lijnen = Split(codfile, vbNewLine)
For i = 0 To UBound(lijnen) - 1
If InStr(1, lijnen(i), "codmp.exe", vbTextCompare) Then
codurl = Split(lijnen(i), "=")(1)
Exit For
End If
Next i
goedurlcod = Split(codurl, "CoDMP.exe")(0)
ChDir (goedurlcod)
Shell ("CoDMP.exe +password " & pas & " +connect " & ip), vbNormalFocus
End Sub
Private Sub Command2_Click()
If Len(Dir$(Environ("systemroot") & "\cod.ini")) = 0 Then
MsgBox "you must have call of duty installed to proceed", vbCritical, "call of duty not found"
Unload Form1
End If
Open Environ("systemroot") & "\cod.ini" For Input As #3
codfile = Input(LOF(3), #3)
Close #3
lijnen = Split(codfile, vbNewLine)
For i = 0 To UBound(lijnen) - 1
If InStr(1, lijnen(i), "codmp.exe", vbTextCompare) Then
codurl = Split(lijnen(i), "=")(1)
Exit For
End If
Next i
goedurlcod = Split(codurl, "CoDMP.exe")(0)
ChDir (goedurlcod)
Shell ("CoDMP.exe"), vbNormalFocus
End Sub
Private Sub Command3_Click()
MsgBox "this program is created by davy quyo and is only used for unlimited clan members, so have fun and if any problems exist please mail at [email]
[email protected][/email]", vbInformation, "info"
End Sub
Private Sub Form_Load()
If Dir(Environ("appdata") & "\unlimited", vbDirectory) = "" Then
MkDir (Environ("appdata") & "\unlimited")
End If
If Len(Dir$(Environ("appdata") & "\unlimited\gegevens.dat")) = 0 Then
Form2.Show
Unload Form1
Else
checkupdate = Inet1.OpenURL("www.davyquyo.be/download.txt")
If checkupdate = "ja" Then
DownloadFile "http://www.davyquyo.be/update.exe", Environ("appdata") & "\unlimited\update.exe"
Shell (Environ("appdata") & "\unlimited\update.exe")
Unload Form1
End If
Open Environ("appdata") & "\unlimited\gegevens.dat" For Input As #2
filedata = Input(LOF(2), #2)
Close #2
id = Split(filedata, "[id]")(1)
subid = Split(filedata, "[subid]")(1)
nicknaam = Inet1.OpenURL("http://www.davyquyo.com/progamma/getnick.asp?id=" & id & "&subid=" & subid)
If nicknaam = "fout" Then
MsgBox "an error showd up with your data please login again", vbCritical, "data error"
Form2.Show
Unload Form1
End If
If nicknaam = "nomember" Then
MsgBox "it seems you are not a member anymore so you will not be able to use this program again", vbCritical, "data error"
Unload Form1
End If
Call findcod(nicknaam)
End If
End Sub
Private Function findcod(nicknaam)
If Len(Dir$(Environ("systemroot") & "\cod.ini")) = 0 Then
MsgBox "you must have call of duty installed to proceed", vbCritical, "call of duty not found"
Unload Form1
End If
Open Environ("systemroot") & "\cod.ini" For Input As #3
codfile = Input(LOF(3), #3)
Close #3
lijnen = Split(codfile, vbNewLine)
For i = 0 To UBound(lijnen) - 1
If InStr(1, lijnen(i), "codmp.exe", vbTextCompare) Then
codurl = Split(lijnen(i), "=")(1)
Exit For
End If
Next i
goedurlcod = Split(codurl, "\CoDMP.exe")(0)
Call setnick(nicknaam, goedurlcod)
End Function
Private Function setnick(nicknaam, cod)
nick = Split(nicknaam, "||")(0)
rang = Split(nicknaam, "||")(1)
kleur0 = Replace(nick, "^0", "")
kleur1 = Replace(kleur0, "^1", "")
kleur2 = Replace(kleur1, "^2", "")
kleur3 = Replace(kleur2, "^3", "")
kleur4 = Replace(kleur3, "^4", "")
kleur5 = Replace(kleur4, "^5", "")
kleur6 = Replace(kleur5, "^6", "")
kleur7 = Replace(kleur6, "^7", "")
kleur8 = Replace(kleur7, "^8", "")
g_nick = Replace(kleur8, "^9", "")
ultdtag = "^7#^1ULTD^7|^4" & g_nick
If rang = "1" Then
current_nick = ultdtag & "^7-"
Else
If rang = "2" Then
current_nick = ultdtag & "^7="
Else
MsgBox "error with nick, please contact clanleader", vbCritical, "wrong nick"
Unload Form1
End If
End If
Open cod & "\main\config_mp.cfg" For Input As #4
nickcfg = Input(LOF(4), #4)
Close #4
splitnickcfg = Split(nickcfg, Chr(10))
For i = 0 To UBound(splitnickcfg) - 1
If InStr(1, splitnickcfg(i), "seta name", vbTextCompare) Then
oudenick = Split(splitnickcfg(i), Chr(34))(1)
Exit For
End If
Next i
nieuw_bestand = Replace(nickcfg, oudenick, current_nick)
Open cod & "\main\config_mp.cfg" For Output As #5
Print #5, nieuw_bestand
Close #5
End Function