Server Kontrol Programı v2.0 [ Visual Basic Source ]

TrayhopeR
Konu Yazar

TrayhopeR

www.trayhoper.net
May
2,830
62
Işinize yarayacağını düşünerek yayınlıyorum .. Benim için yazması zor olmuştu ama sizin için öğrenmesi kolay olur inşallah :^^:

Kod Kısmı :
Kod: 
' ## Server Kontrol Programı Source Codes ## '
Dim trayhoper As New ADODB.Connection
Dim tray As New ADODB.Recordset
Dim veritabani1, user12, pass1, ipadresi1 As String
Dim char As String
Dim zone, zoneisim As String
Dim clan, clanisim As String
Dim clanvar, charvar As Boolean
Dim sifre, yenisifre As String
Dim strHesap As String
Dim nRet, cRet, iRet, sRet, kRet, aRet As String
Dim oyundamiacep As String
Dim user1, user2, user3 As String
Dim raptorap, raptordd, raptorsd, raptorad As String
Dim elixirap, elixirdd, elixirsd, elixirad As String
Dim ironap, irondd, ironsd, ironad As String
Dim shardap, sharddd, shardsd, shardad As String
Dim skillkod, skillad, skilllwl, skillhit, skillzehir, skillmp, skillatt As String
Dim itemkod, itemad, itemap, itemdd, itemsd, itemadac, itemmd, itembd, itemswd, itemstr, itemdex, itemint, itemhp, itemmp, itemac, itemdur, itemhpb, itemmpb, itemnpc, itemsatis As String
Dim tamad, tamad1, tamad2, tamad3, tamad4 As String
Dim itemdwid, itemadet As String
Dim p1ad, p2ad, p3ad, p4ad, p5ad, p6ad, p7ad, p8ad, p9ad, p10ad, p11ad, p12ad, p13ad, p14ad, p15ad, p16ad, p17ad, p18ad, p19ad, p20ad, p21ad, p22ad, p23ad, p24ad, p25ad, p26ad, p27ad, p28ad As String
Dim p1izin, p2izin, p3izin, p4izin, p5izin, p6izin, p7izin, p8izin, p9izin, p10izin, p11izin, p12izin, p13izin, p14izin, p15izin, p16izin, p17izin, p18izin, p19izin, p20izin, p21izin, p22izin, p23izin, p24izin, p25izin, p26izin, p27izin, p28izin As String
Dim usersira, userad As String
Dim gmacc, gmid, gmpass As String
Dim useracc, userid, userpass As String
Dim pkontrol As String
Dim clanadi, clansef, clana1, clana2, clana3 As String
Dim satis As String
Dim irkkodu As String
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Sub Command1_Click()
Check
sifirla
claninfo.Caption = "Clan : YOK"
Label19.Caption = "Online :"
Frame2.Visible = False
char = Trim(Text1.Text)
charadi.Caption = char
trayhoper.Execute "truncate table itemler"
trayhoper.Execute "itemleri_bul '" & char & "'"
' -- Temel Bilgiler
Frame9.Visible = True
Check
tray.Open "Select strAccountID FROM ACCOUNT_CHAR WHERE strCharID1 = '" & char & "' OR strCharID2 = '" & char & "' OR strCharID3 = '" & char & "'", trayhoper, 1, 3
aRet = tray.RecordCount
If aRet > 0 Then
    charvar = True
    Else
    charvar = False
End If
Check
tray.Open "Select strUserID FROM USERDATA WHERE strUserID = '" & char & "'", trayhoper, 1, 3
kRet = tray.RecordCount
If Not kRet > 0 Then
    If charvar = True Then
        MsgBox "Girdiğiniz charın bir hesabı var.Fakat veritabanında böyle bir karakter yok.Server Dosyalarınızın güvenliği için karakterin hesabı silinecektir !", vbCritical
        trayhoper.Execute "DELETE FROM ACCOUNT_CHAR WHERE strCharID1 = '" & char & "' OR strCharID2 = '" & char & "' OR strCharID3 = '" & char & "'"
        Frame2.Visible = False
        Exit Sub
        Else
        
    End If
Frame2.Visible = False
MsgBox "Karakter Bulunamadı !", vbCritical
Frame9.Visible = 0
Exit Sub
End If
Check
tray.Open "Select strCharID FROM CURRENTUSER WHERE strCharID = '" & char & "'", trayhoper, 1, 3
nRet = tray.RecordCount
If nRet > 0 Then
    MsgBox "Kullanıcı oyunda gözüküyor .. Bu nedenle yapacağınız değişiklikler etkili olmayacaktır ! Kullanıcı oyundan çıktığı zaman üzerinde değişiklik yapabilirsiniz .. !", vbInformation
    oyundami.Caption = "Evet"
    oyundami.ForeColor = vbRed
    oyundaami.Caption = "OYUNDA"
    oyundaami.ForeColor = vbRed
Else
    oyundami.Caption = "Hayır"
    oyundami.ForeColor = vbBlue
    oyundaami.Caption = "OYUNDA DEGIL"
    oyundaami.ForeColor = vbBlue
End If
tray.Close

Frame2.Visible = True
tray.Open "Select * FROM USERDATA WHERE strUserID = '" & char & "'", trayhoper, 1, 3

level.Caption = "Level :" & tray!level
irkkodu = tray!nation
If tray!nation = 2 Then
    irk.Caption = "Human"
    irkkodu = "1"
    Else
    irk.Caption = "Orc"
    irkkodu = "2"
End If
zone = tray!zone
clan = tray!Knights
para.Caption = "Para :" & tray!gold
lpuan.Caption = "Aylık NP :" & tray!LoyaltyMonthly
puan.Caption = "NP :" & tray!loyalty
levvel.Text = tray!level
Label5.Caption = levvel.Text & " LWL"
nnp.Text = tray!loyalty
nepesi.Caption = "NP : " & nnp.Text
npp.Text = tray!LoyaltyMonthly
parra.Text = tray!gold
str.Text = tray!strong
Text40.Text = tray!Points
dex.Text = tray!dex
intel.Text = tray!intel
cha.Text = tray!sta
magic.Text = tray!cha
manner.Caption = "Manner : " & tray!MannerPoint
tray.Close
' -- Harita Bilgisi
tray.Open "Select * FROM ZONE_INFO WHERE ZoneNO = '" & zone & "'", trayhoper, 1, 3
zoneisim = tray!bz
zoneinfo.Caption = "Harita : " & zoneisim
tray.Close
' -- Clan Bilgisi
tray.Open "Select IDName FROM KNIGHTS WHERE IDNum = '" & clan & "'", trayhoper, 1, 3
cRet = tray.RecordCount
If cRet > 0 Then
clanisim = tray!IDName
clanvar = True
claninfo.Caption = "Clan : " & clanisim
tray.Close
Else

End If
' -- Char Bilgisi
Check

tray.Open "Select * FROM ACCOUNT_CHAR WHERE strCharID1 = '" & char & "' OR strCharID2 = '" & char & "' OR strCharID3 = '" & char & "'", trayhoper, 1, 3
strHesap = Trim(tray!straccountid)
hesap.Caption = "Hesap : " & tray!straccountid
char1.Caption = "1. Karakter : " & Trim(tray!strcharid1)
char2.Caption = "2. Karakter : " & Trim(tray!strcharid2)
char3.Caption = "3. Karakter : " & Trim(tray!strCharID3)
text6.Text = Trim(strHesap)
If IsNull(tray!strcharid1) = False Then
    text7.Text = Trim(tray!strcharid1)
End If
If IsNull(tray!strcharid2) = False Then
    text8.Text = Trim(tray!strcharid2)
End If
If IsNull(tray!strCharID3) = False Then
    Text9.Text = Trim(tray!strCharID3)
End If
tray.Close
' -- Mail Bilgisi
tray.Open "Select * FROM TB_USER WHERE strAccountID = '" & strHesap & "'", trayhoper, 1, 3
If IsNull(tray!strEMail) = False Then
On Error GoTo mailyok
    mail.Caption = tray!strEMail
End If
    sifre = tray!strpasswd
    Text11.Text = sifre

tray.Close
hessap.Text = Trim(strHesap)
If text7.Text = vbNullString Then
Command6.Enabled = False
End If
If text8.Text = vbNullString Then
Command7.Enabled = False
End If
If Text9.Text = vbNullString Then
Command8.Enabled = False
End If
durum.Caption = char & " Isimli karakter yüklendi !"
If tray.State = 1 Then
tray.Close
End If
Exit Sub
accyok:
If Err.Number = "3021" Then
trayhoper.Execute "DELETE FROM USERDATA WHERE strUserID = '" & char & "'"
MsgBox "Karakterin hesabı bulunmuyor.Hesabı olmayan karakterler server fileslarına zarar verebilir.Server güvenliği için karakter db den silinecek !", vbInformation
Frame2.Visible = False
End If
Exit Sub
mailyok:
MsgBox "Karakterin mail adresi bos gozukuyor .. Bu nedenle bazı bilgiler gösterilmeyecektir ! TB_USER tablosunda strEmail sekmesi butun karakterlerin dolu olmasi gerekir...", vbCritical
Exit Sub
End Sub

Private Sub Command10_Click()
elixirap = Text10.Text
elixirdd = Text12.Text
elixirsd = Text13.Text
elixirad = Text14.Text
trayhoper.Execute "Update ITEM Set Damage = '" & elixirap & "' WHERE Num = '181110188'"
trayhoper.Execute "Update Item Set DaggerAc = '" & elixirdd & "' WHERE Num = '181110188'"
trayhoper.Execute "Update ITEM Set SpearAc = '" & elixirsd & "' WHERE Num = '181110188'"
trayhoper.Execute "Update ITEM Set AxeAc = '" & elixirad & "' WHERE Num = '181110188'"
stat "Elixir Bilgisi Kayıt Edildi !"
End Sub

Private Sub Command11_Click()
ironap = Text15.Text
irondd = Text16.Text
ironsd = Text17.Text
ironad = Text18.Text
trayhoper.Execute "Update ITEM Set Damage = '" & ironap & "' WHERE Num = '168410048'"
trayhoper.Execute "Update Item Set DaggerAc = '" & irondd & "' WHERE Num = '168410048'"
trayhoper.Execute "Update ITEM Set SpearAc = '" & ironsd & "' WHERE Num = '168410048'"
trayhoper.Execute "Update ITEM Set AxeAc = '" & ironad & "' WHERE Num = '168410048'"
stat "Iron Bow Bilgisi Kayıt Edildi !"
End Sub

Private Sub Command12_Click()
shardap = Text19.Text
sharddd = Text20.Text
shardsd = Text21.Text
shardad = Text22.Text
trayhoper.Execute "Update ITEM Set Damage = '" & shardap & "' WHERE Num = '111210048'"
trayhoper.Execute "Update Item Set DaggerAc = '" & sharddd & "' WHERE Num = '111210048'"
trayhoper.Execute "Update ITEM Set SpearAc = '" & shardsd & "' WHERE Num = '111210048'"
trayhoper.Execute "Update ITEM Set AxeAc = '" & shardad & "' WHERE Num = '111210048'"
stat "Shard Bilgisi Kayıt Edildi !"
End Sub

Private Sub Command13_Click()
Dim sorgu11 As String
sorgu11 = "INSERT INTO item ( [Num], [strName], [Kind], [Slot], [Race], [Class], [Damage], [Delay], [Range], [Weight], [Duration], [BuyPrice], [SellPrice], [Ac], [Countable], [Effect1], [Effect2], [ReqLevel], [ReqLevelMax], [ReqRank], [ReqTitle], [ReqStr], [ReqSta], [ReqDex], [ReqIntel], [ReqCha], [SellingGroup], [ItemType], [Hitrate], [Evasionrate], [DaggerAc], [SwordAc], [MaceAc], [AxeAc], [SpearAc], [BowAc], [FireDamage], [IceDamage], [LightningDamage], [PoisonDamage], [HPDrain], [MPDamage], [MPDrain], [MirrorDamage], [Droprate], [StrB], [StaB], [DexB], [IntelB], [ChaB], [MaxHpB], [MaxMpB], [FireR], [ColdR], [LightningR], [MagicR], [PoisonR], [CurseR] ) VALUES ( 391010000, 'Arrow (+0)', 120, 15, 0, 0, 0, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1, 99, 0, 0, 0, 0, 0, 0, 0, 255, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );"
trayhoper.Execute sorgu11
durum.Caption = "Arrow Eklendi !"
End Sub

Private Sub Command14_Click()
trayhoper.Execute "Delete from ITEM WHERE Num = '391010000'"
durum.Caption = "Arrow Kaldırıldı !"
End Sub

Private Sub Command15_Click()
On Error GoTo hata
Check
Frame7.Visible = False
Frame8.Visible = False
itemkod = Trim(Text23.Text)
If itemkod = vbNullString Then MsgBox "Boş Bırakamazsınız !", vbCritical: durum.Caption = "Islem Basarısız Oldu !": Exit Sub
If Len(itemkod) < 9 Or Len(itemkod) > 9 Then MsgBox "Item kodu 9 dan büyük veya küçük olamaz !", vbCritical: Exit Sub

Check
tray.Open "Select * FROM ITEM WHERE Num = '" & itemkod & "'", trayhoper, 1, 3
itemap = Trim(tray!Damage)
itemkodu.Caption = Trim(tray!strName)
tamad = Len(itemkodu.Caption)
tamad1 = Right(itemkodu.Caption, 4)
tamad2 = Len(tamad1)
tamad3 = Int(tamad - tamad2)
tamad4 = Left(itemkodu.Caption, tamad3)
itemkodu.Caption = tamad4
Label61.Caption = tamad1
itemac = tray!AC
itemdd = tray!DaggerAc
itemsd = tray!SpearAc
itemadac = tray!AxeAc
itemmd = tray!MaceAc
itemswd = tray!SwordAc
itembd = tray!BowAc
itemdur = tray!Duration
itemstr = tray!ReqStr
itemdex = tray!ReqDex
itemint = tray!ReqIntel
itemhp = tray!ReqSta
itemmp = tray!ReqCha
itemhpb = tray!MaxHpB
itemmpb = tray!MaxMpB
itemnpc = tray!SellingGroup
itemsatis = tray!SellPrice
Text24.Text = itemap
Text25.Text = itemdd
Text26.Text = itemsd
Text27.Text = itemadac
Text28.Text = itemmd
Text29.Text = itemswd
Text30.Text = itembd
Text31.Text = itemdur
Text32.Text = itemac
Text38.Text = itemhpb
Text39.Text = itemmpb
Text33.Text = itemstr
Text34.Text = itemdex
Text35.Text = itemint
Text36.Text = itemhp
Text37.Text = itemmp
Label63.Caption = itemsatis + " Coin"
Check
satilik.Caption = "YOK"
If Not itemnpc = 0 Then
On Error Resume Next
tray.Open "Select * FROM K_NPC WHERE iSellingGroup like '%" & itemnpc & "%'", trayhoper, 1, 3
satilik.Caption = tray!strName
Command17.Enabled = True
Check
End If
If satilik.Caption = "YOK" Then Command17.Enabled = False
stat "Bilgiler Yuklendi !"
Frame7.Visible = True
Frame8.Visible = True
Exit Sub
hata:
If Err.Number = "3021" Then
MsgBox "Böyle bir kayıt bulunamadı !"
Else
MsgBox "Bilinmeyen hata oluştu ! Hata kodu : " & Err.Number
End If
End Sub


Private Sub Command16_Click()
itemap = Text24.Text
itemdd = Text25.Text
itemsd = Text26.Text
itemadac = Text27.Text
itemmd = Text28.Text
itemswd = Text29.Text
itembd = Text30.Text
itemdur = Text31.Text
itemac = Text32.Text
itemhpb = Text38.Text
itemmpb = Text39.Text
itemstr = Text33.Text
itemdex = Text34.Text
itemint = Text35.Text
itemhp = Text36.Text
itemmp = Text37.Text
trayhoper.Execute "Update ITEM Set Damage = '" & itemap & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set DaggerAc = '" & itemdd & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set SpearAc = '" & itemsd & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set AxeAc = '" & itemadac & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set MaceAc = '" & itemmd & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set SwordAc = '" & itemswd & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set BowAc = '" & itembd & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set Duration = '" & itemdur & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set AC = '" & itemac & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set MaxHpB = '" & itemhpb & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set MaxMpB = '" & itemmpb & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set ReqStr = '" & itemstr & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set ReqDex = '" & itemdex & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set ReqIntel = '" & itemint & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set ReqSta = '" & itemhp & "' WHERE Num = '" & itemkod & "'"
trayhoper.Execute "Update ITEM Set ReqCha = '" & itemmp & "' WHERE Num = '" & itemkod & "'"
stat "Butun bilgiler basariyla kaydedildi !"
End Sub

Private Sub Command17_Click()
trayhoper.Execute "Update ITEM Set SellingGroup = '0' WHERE Num = '" & itemkod & "'"
stat "Itemin npclerden alınması engellendi !!"
End Sub

Private Sub Command18_Click()
Dim soru2 As String
If nRet = 1 Then
MsgBox "Kullanıcı oyunda oldugu için işlem yapamazsınız !", vbCritical
Exit Sub
End If
soru2 = MsgBox("Sileceğiniz itemler tekrar getirilemeyecek,yine de silmek istiyormusunuz ?", vbInformation + vbYesNo)
If soru2 = vbNo Then
Exit Sub
Else
trayhoper.Execute "Update USERDATA Set strItem = '' where struserid = '" & char & "'"
MsgBox char & " itemleri silindi !", vbInformation
End If
End Sub

Private Sub Command19_Click()
Check
Command23.Visible = 0
Command25.Visible = 0
Command26.Visible = 0
gmid2.Visible = 0
Label22.Visible = 0
gmchar1.Visible = 0
gmchar2.Visible = 0
gmchar3.Visible = 0
Shape12.Visible = 0
List1.Clear
tray.Open "Select * FROM USERDATA WHERE Authority = '0'", trayhoper, 1, 3
Do Until tray.EOF
List1.AddItem tray!strUserID
tray.MoveNext
Loop
stat "GM ler Yuklendi !"
If List1.ListCount = 0 Then
MsgBox "Serverda GM Bulunamadı !", vbCritical
End If
If Label65.Visible = True Then
Label65.Visible = False
End If
End Sub

Private Sub Command2_Click()
If Int(parra.Text) > Int("2100000000") Then
MsgBox "Bir kullanıcıya 2.100.000.000 dan yuksek para veremezsiniz !", vbInformation
Exit Sub
End If
If nRet = 1 Then
    MsgBox "Kullanıcı oyunda oldugu için yaptığınız değişiklikler gerçekleştirilemedi !", vbCritical
    Else
    strHesap = text6.Text
    trayhoper.Execute "Update USERDATA Set Strong = '" & str.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Dex = '" & dex.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Intel = '" & intel.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Cha = '" & magic.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Sta = '" & cha.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Level = '" & levvel.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Gold = '" & parra.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Loyalty = '" & nnp.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set Points = '" & Text40.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update USERDATA Set LoyaltyMonthly = '" & npp.Text & "' WHERE strUserID = '" & char & "'"
    trayhoper.Execute "Update ACCOUNT_CHAR Set strCharID1 = '" & text7.Text & "' WHERE strAccountID = '" & strHesap & "'"
    trayhoper.Execute "Update ACCOUNT_CHAR Set strCharID2 = '" & text8.Text & "' WHERE strAccountID = '" & strHesap & "'"
    trayhoper.Execute "Update ACCOUNT_CHAR Set strCharID3 = '" & Text9.Text & "' WHERE strAccountID = '" & strHesap & "'"
    MsgBox "Bütün değisiklikler basariyla kaydedildi !!", vbInformation
End If
End Sub

Private Sub Command20_Click()
If nRet = 1 Then
MsgBox "Kullanıcı Oyunda Gözüktüğü Icin Islem Gerceklestirilemiyor !", vbCritical
Else
trayhoper.Execute "DELETE FROM USERDATA WHERE strUserID = '" & char & "'"
MsgBox "Karakter Silindi !", vbInformation
End If
End Sub

Private Sub Command21_Click()
MsgBox "Bu program TrayhopeR tarafından yazılmistir .." + vbCrLf + "www.PWTURKEY.com" + vbCrLf + "www.KO-CUCE.com", vbExclamation + vbRetryCancel
End Sub

Private Sub Command22_Click()
Open App.Path & "\" & char & ".txt" For Append As #1
Print #1, "Log Tarihi : " & Date
Print #1, "Log Saati : " & Time
Print #1, ""
Print #1, liste1.Text
Close #1
stat App.Path & "\" & char & ".txt Olarak kayıt edildi !!"
End Sub

Private Sub Command23_Click()
If Not gmid = vbNullString Then
Dim soru11 As String
soru11 = MsgBox(gmid & " isimli gm in yetkisini almak istiyormusun ?", vbInformation + vbYesNo)
If soru11 = vbYes Then
trayhoper.Execute "Update USERDATA Set Authority = '1' WHERE strUserID = '" & gmid & "'"
MsgBox gmid & " isimli gm in yetkisi alınıp normal player a dönüstürüldü.Bu degisiklikler eger gm oyundaysa etkili olmayacaktir !", vbInformation
Command19_Click
Else

End If
Else
MsgBox "Önce bir gm secmelisin !", vbInformation
End If

End Sub

Private Sub Command24_Click()
If clanvar = True Then
    If nRet > 0 Then
        Dim soru77 As String
        soru77 = MsgBox(char & " isimli kullanıcı " & clanisim & " clanından atılacak.Eminmisin ?", vbInformation + vbYesNo)
            If soru77 = vbYesNo Then
                trayhoper.Execute "Update USERDATA Set Knights = '0' WHERE strUserID = '" & char & "'"
                MsgBox "Islem Tamamlandı !", vbInformation
            Else
                Exit Sub
            End If
        Else
        MsgBox "Kullanıcı Oyunda Oldugu Icin Islem Gerceklestirilemedi !", vbCritical
    End If
Else
MsgBox "Kullanıcı clanda değil !", vbCritical
End If
End Sub

Private Sub Command25_Click()
If Not gmid = vbNullString Then
Dim soru24, soru11 As String
soru23 = MsgBox(gmid & " Isimli gm in sifresini gercekten desgistirmek istiyormusun ?", vbInformation + vbYesNo)
    If soru23 = vbYes Then
        soru11 = InputBox("Yeni gm sifresini girin :)")
        trayhoper.Execute "Update TB_USER Set strPassWd = '" & soru11 & "' WHERE strAccountID = '" & gmacc & "'"
        MsgBox gmacc & " hesaplı gm in yeni sifresi : " & soru11 & " olarak degistirildi !", vbInformation
        Command19_Click
    Else
        Exit Sub
    End If
Else
MsgBox "Once bir gm secmelisin !", vbInformation
Exit Sub
End If
End Sub

Private Sub Command26_Click()
If Not gmid = vbNullString Then
Dim soru23, soru22 As String
soru23 = MsgBox(gmid & " Isimli gm in hesabını gerçekten değiştirmek istiyormusunuz ?", vbInformation + vbYesNo)
    If soru23 = vbYes Then
        soru22 = InputBox("Yeni gm hesabını girin :)")
        trayhoper.Execute "Update TB_USER Set strAccountID = '" & soru22 & "' WHERE strAccountID = '" & gmacc & "'"
        trayhoper.Execute "Update ACCOUNT_CHAR Set strAccountID = '" & soru22 & "' WHERE strAccountID = '" & gmacc & "'"
        MsgBox gmid2.Caption + " hesaplı gm in yeni hesabı : " & soru22 & " yapıldı !", vbInformation
        Command19_Click
    Else
        Exit Sub
    End If
Else
MsgBox "Once bir gm secmelisin !", vbInformation
Exit Sub
End If
End Sub

Private Sub Command27_Click()
List2.Clear
Label65.Visible = False
Label66.Visible = 0
Label67.Visible = 0
Label68.Visible = 0
Label69.Visible = 0
Command28.Visible = 0
Command29.Visible = 0
Command30.Visible = 0
Shape13.Visible = 0
Check
tray.Open "Select * FROM USERDATA WHERE Authority = '1'", trayhoper, 1, 3
Do Until tray.EOF
List2.AddItem tray!strUserID
tray.MoveNext
Loop
stat "Userlar Yuklendi !"
If List2.ListCount = 0 Then
    MsgBox "Oyunda hiç user yok !", vbCritical
End If
End Sub

Private Sub Command28_Click()
If Not userid = vbNullString Then
Dim soru23, soru22 As String
soru23 = MsgBox(userid & " Isimli user in hesabını gerçekten değiştirmek istiyormusunuz ?", vbInformation + vbYesNo)

    If soru23 = vbYes Then
        soru22 = InputBox("Yeni hesabı girin :)")
            If soru22 = vbNullString Then
                
            Exit Sub
                Else

            End If
        trayhoper.Execute "Update TB_USER Set strAccountID = '" & soru22 & "' WHERE strAccountID = '" & useracc & "'"
        trayhoper.Execute "Update ACCOUNT_CHAR Set strAccountID = '" & soru22 & "' WHERE strAccountID = '" & useracc & "'"
        MsgBox Label69.Caption + " hesaplı gm in yeni hesabı : " & soru22 & " yapıldı !", vbInformation
        Command27_Click
        
        Else
    Exit Sub
    End If
Else
MsgBox "Once bir user secmelisin !", vbInformation
Exit Sub
End If
End Sub

Private Sub Command3_Click()
On Error GoTo hata
Dim emin As String
emin = MsgBox(Trim(strHesap) & " isimli hesaptaki bütün charların irkini degistirmek istiyormusunuz ?", vbYesNo + vbQuestion)
If emin = vbYes Then
    trayhoper.Execute "EXEC ACCOUNT_NATION_CHANGE '" & strHesap & "','" & irkkodu & "'"
    MsgBox strHesap & " isimli hesaptaki bütün karakterler düzeltildi !", vbInformation
    Else
Exit Sub
End If
Exit Sub
hata:
If Err.Number = "-2147217900" Then
    MsgBox "ACCOUNT_NATION_CHANGE prosedürü ekli değil ! Prosedürü eklemeden bu islemi yapamazsınız ..", vbCritical
    Exit Sub
End If
End Sub

Private Sub Command30_Click()
If Not userid = vbNullString Then
Dim soru11 As String
soru11 = MsgBox(userid & " isimli usera gm yetkisini vermek istiyormusun ?", vbInformation + vbYesNo)
If soru11 = vbYes Then
trayhoper.Execute "Update USERDATA Set Authority = '0' WHERE strUserID = '" & userid & "'"
MsgBox userid & " isimli playera gm yetkisi verildi ! Karakter oyundaysa yapılan değisiklikler etkili olmayacaktir ..", vbInformation
Command27_Click
Command19_Click
Else

End If
Else
MsgBox "Önce bir user secmelisin !", vbInformation
End If

End Sub

Private Sub Command31_Click()
Command19_Click
End Sub

Private Sub Command32_Click()
Command27_Click
End Sub

Private Sub Command33_Click()
trayhoper.Execute "Update USERDATA Set Authority = '1' WHERE Authority = '0'"
MsgBox "Butun gmler alındı ! Yapılan degisiklikler,gmler oyundaysa gecerli olmayacaktir ..", vbInformation

End Sub

Private Sub Command34_Click()
Dim soru As String
soru = MsgBox("Bu islem geri dondurulemeyecek büyük bir islem.Userları YEDEKLEMEDEN butun userları silmek istediginizden eminmisiniz ?", vbInformation + vbYesNo)
    If soru = vbYes Then
        trayhoper.Execute "truncate table USERDATA"
        MsgBox "Islem basariyla tamamlandi ! Butun kullanıcılar veritabanından silindi ..", vbInformation
    Else
    Exit Sub
    End If
    
End Sub

Private Sub Command35_Click()
Dim soru As String
soru = MsgBox("Bu islem geri dondurulemeyecek büyük bir islem.Butun userları gm yapmak bir cılgınlık :) Genede yapmak istiyormusun ? O_o", vbInformation + vbYesNo)
    If soru = vbYes Then
        trayhoper.Execute "Update USERDATA Set Authority = '0' WHERE Authority = '1'"
        MsgBox "Islem basariyla tamamlandi ! Suan oyunda olmayan butun kullanıcılar gm yapıldı !", vbInformation
        Command19_Click
        Command27_Click
    Else
    Exit Sub
    End If
    
End Sub

Private Sub Command36_Click()
trayhoper.Execute "Update USERDATA Set Authority = '1' WHERE Authority = '0'"
MsgBox "Butun gmler user yapıldı !", vbInformation
Command27_Click
Command19_Click
End Sub

Private Sub Command37_Click()
Dim soru As String
soru = MsgBox("Bu islem geri dondurulemeyecek büyük bir islem.Oyundaki butun hesapları silmek istediginizden eminmisiniz ?", vbInformation + vbYesNo)
    If soru = vbYes Then
        trayhoper.Execute "truncate table TB_USER"
        MsgBox "Islem basariyla tamamlandi ! Butun hesaplar silindi ..", vbInformation
    Else
    Exit Sub
    End If
    
End Sub

Private Sub Command38_Click()
Dim soru As String
soru = MsgBox("Bu islem geri dondurulemeyecek büyük bir islem.Hesaplardaki charları sıfırlamak istediginizden eminmisiniz ?", vbInformation + vbYesNo)
    If soru = vbYes Then
        trayhoper.Execute "truncate table ACCOUNT_CHAR"
        MsgBox "Islem basariyla tamamlandi ! Butun hesaplar bosaltıldı !", vbInformation
    Else
    Exit Sub
    End If
End Sub

Private Sub Command39_Click()
Dim soru As String
soru = MsgBox("Bu islem oyunda olmayan bütün kullanıcıların itemlerini siler.Gercekten yapmak istedigine eminmisin ?", vbInformation + vbYesNo)
    If soru = vbYes Then
        trayhoper.Execute "Update USERDATA Set strItem = '' WHERE Authority = '1'"
        MsgBox "Islem basariyla tamamlandi ! Suan oyunda olmayan butun kullanıcıların itemleri silindi !", vbInformation
    Else
    Exit Sub
    End If
    
End Sub

Private Sub Command4_Click()
yenisifre = Text11.Text
trayhoper.Execute "Update TB_USER Set strPasswd = '" & yenisifre & "' WHERE strPasswd = '" & sifre & "'"
durum.Caption = sifre & " Şifresi " & yenisifre & " Olarak değiştirildi !"

End Sub

Private Sub Command40_Click()

End Sub

Private Sub Command5_Click()
Dim emin As String
user1 = text7.Text
user2 = text8.Text
user3 = Text9.Text
emin = MsgBox(Trim(strHesap) & " isimli hesabı gerçekten silmek istiyormusunuz ?", vbYesNo + vbQuestion)
If emin = vbYes Then
trayhoper.Execute "DELETE FROM TB_USER WHERE strAccountID = '" & strHesap & "'"
trayhoper.Execute "DELETE FROM ACCOUNT_CHAR WHERE strAccountID = '" & strHesap & "'"
trayhoper.Execute "DELETE FROM USERDATA WHERE strUserID = '" & user1 & "'"
trayhoper.Execute "DELETE FROM USERDATA WHERE strUserID = '" & user2 & "'"
trayhoper.Execute "DELETE FROM USERDATA WHERE strUserID = '" & user3 & "'"
MsgBox strHesap & " isimli hesap veritabanından silindi !", vbInformation
Else
Exit Sub
End If
End Sub

Private Sub Command6_Click()
Dim emin As String
emin = MsgBox(text7.Text & " isimli karakteri " & strHesap & " isimli hesaptan silmek istediğinizden eminmisiniz ?", vbInformation + vbYesNo)
If emin = vbYes Then
trayhoper.Execute "Update ACCOUNT_CHAR Set strCharID1 = '' WHERE strCharID1 = '" & text7.Text & "'"
MsgBox "Karakter basariyla silindi !", vbInformation
Else
Exit Sub
End If
End Sub

Private Sub Command7_Click()
Dim emin As String
emin = MsgBox(text8.Text & " isimli karakteri " & strHesap & " isimli hesaptan silmek istediğinizden eminmisiniz ?", vbInformation + vbYesNo)
If emin = vbYes Then
trayhoper.Execute "Update ACCOUNT_CHAR Set strCharID2 = '' WHERE strCharID2 = '" & text8.Text & "'"
MsgBox "Karakter basariyla silindi !", vbInformation
Else
Exit Sub
End If
End Sub

Private Sub Command8_Click()
Dim emin As String
emin = MsgBox(Text9.Text & " isimli karakteri " & strHesap & " isimli hesaptan silmek istediğinizden eminmisiniz ?", vbInformation + vbYesNo)
If emin = vbYes Then
trayhoper.Execute "Update ACCOUNT_CHAR Set strCharID3 = '' WHERE strCharID3 = '" & Text9.Text & "'"
MsgBox "Karakter basariyla silindi !", vbInformation
Else
Exit Sub
End If
End Sub

Private Sub Command9_Click()
raptorap = Text2.Text
raptordd = Text3.Text
raptorsd = Text4.Text
raptorad = Text5.Text
trayhoper.Execute "Update ITEM Set Damage = '" & raptorap & "' WHERE Num = '156210048'"
trayhoper.Execute "Update ITEM Set DaggerAc = '" & raptordd & "' WHERE Num = '156210048'"
trayhoper.Execute "Update ITEM Set SpearAc = '" & raptorsd & "' WHERE Num = '156210048'"
trayhoper.Execute "Update ITEM Set AxeAc = '" & raptorad & "' WHERE Num = '156210048'"
stat "Raptor Bilgisi Kayıt Edildi !"
End Sub

Private Sub Form_Load()
veritabani1 = GetSetting("Trayhoper", "Control", "Veritabani")
user12 = GetSetting("Trayhoper", "Control", "User")
pass1 = GetSetting("Trayhoper", "Control", "PASS")
ipadresi1 = GetSetting("Trayhoper", "Control", "IP")
trayhoper.Open "Provider=SQLOLEDB;Data Source='" & ipadresi1 & "';Network Library=DBMSSOCN;Initial Catalog='" & veritabani1 & "';User ID='" & user12 & "';Password='" & pass1 & "';"
' Raptor Bilgisi
Check
tray.Open "Select * FROM ITEM WHERE Num = '156210048'", trayhoper, 1, 3
raptorap = tray!Damage
raptordd = tray!DaggerAc
raptorsd = tray!SpearAc
raptorad = tray!AxeAc
Text2.Text = raptorap
Text3.Text = raptordd
Text4.Text = raptorsd
Text5.Text = raptorad
Check
' Elixir Bilgisi
tray.Open "Select * FROM ITEM WHERE Num = '181110188'", trayhoper, 1, 3
elixirap = tray!Damage
elixirsd = tray!SpearAc
elixirdd = tray!DaggerAc
elixirad = tray!AxeAc
Text10.Text = elixirap
Text12.Text = elixirdd
Text13.Text = elixirsd
Text14.Text = elixirad
Check
' Iron Bow Bilgisi
tray.Open "Select * FROM ITEM WHERE Num = '168410048'", trayhoper, 1, 3
ironap = tray!Damage
irondd = tray!DaggerAc
ironsd = tray!SpearAc
ironad = tray!AxeAc
Text15.Text = ironap
Text16.Text = irondd
Text17.Text = ironsd
Text18.Text = ironad
Check
' Shard Bilgisi
tray.Open "Select * FROM ITEM WHERE Num = '111210048'", trayhoper, 1, 3
shardap = tray!Damage
sharddd = tray!DaggerAc
shardsd = tray!SpearAc
shardad = tray!AxeAc
Text19.Text = shardap
Text20.Text = sharddd
Text21.Text = shardsd
Text22.Text = shardad
tray.Close

End Sub
Public Sub Check()
If tray.State = 1 Then
tray.Close
End If

End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub Label3_Click()

End Sub

Private Sub Label63_Click()
satis = InputBox("Itemin Yeni Satıs Fiyatını Girin ( Coin Olarak )", "Trayhoper's Control Program")
If satis = vbNullString Then MsgBox "Boş Bırakamazsınız !", vbCritical: Exit Sub
If Int(satis) > 2100000000 Then MsgBox "2 milyar 100 milyon coinden fazla miktar giremezsiniz '", vbCritical: Exit Sub
trayhoper.Execute "Update ITEM Set SellPrice = '" & satis & "' WHERE Num = '" & itemkod & "'"
stat "Yeni değer başarıyla girildi !"

End Sub

Private Sub List1_Click()
Check
Command23.Visible = True
Command25.Visible = True
Command26.Visible = True
gmid2.Visible = True

Label22.Visible = True
gmchar1.Visible = True
gmchar2.Visible = True
gmchar3.Visible = True
Shape12.Visible = True
gmid = Trim(List1.Text)
tray.Open "Select * FROM ACCOUNT_CHAR WHERE strCharID1 = '" & gmid & "' OR strCharID2 = '" & gmid & "' OR strCharID3 = '" & gmid & "'", trayhoper, 1, 3
On Error GoTo gmacc
gmacc = Trim(tray!straccountid)
gmid2.Caption = "Hesap : " & gmacc
If IsNull(tray!strcharid1) = False Then
    gmchar1.Caption = "1. Karakter : " & Trim(tray!strcharid1)
    Else
    gmchar1.Caption = "## CHAR YOK ##"
End If
If IsNull(tray!strcharid2) = False Then
    gmchar2.Caption = "2. Karakter : " & Trim(tray!strcharid2)
    Else
    gmchar2.Caption = "## CHAR YOK ##"
End If
If IsNull(tray!strCharID3) = False Then
    gmchar3.Caption = "3. Karakter : " & Trim(tray!strCharID3)
    Else
    gmchar3.Caption = "## CHAR YOK ##"
End If
Check
tray.Open "Select * FROM TB_USER WHERE strAccountID = '" & gmacc & "'", trayhoper, 1, 3
Label22.Caption = "Sifre : " & tray!strpasswd
stat "GM " & gmid & " Yuklendi !"
Check
Exit Sub
gmacc:
MsgBox "GM Hesabı Bulurken Hata !", vbCritical

End Sub

Private Sub List2_Click()
Check
Label65.Visible = True
Label66.Visible = True
Label67.Visible = True
Label68.Visible = True
Label69.Visible = True
Command28.Visible = True
Command29.Visible = True
Command30.Visible = True
Shape13.Visible = True
userid = Trim(List2.Text)
tray.Open "Select * FROM ACCOUNT_CHAR WHERE strCharID1 = '" & userid & "' OR strCharID2 = '" & userid & "' OR strCharID3 = '" & userid & "'", trayhoper, 1, 3
useracc = Trim(tray!straccountid)
Label69.Caption = "Hesap : " & useracc
If IsNull(tray!strcharid1) = False Then
    Label68.Caption = "1. Karakter : " & Trim(tray!strcharid1)
    Else
    Label68.Caption = "## CHAR YOK ##"
End If
If IsNull(tray!strcharid2) = False Then
    Label67.Caption = "2. Karakter : " & Trim(tray!strcharid2)
    Else
    Label67.Caption = "## CHAR YOK ##"
End If
If IsNull(tray!strCharID3) = False Then
    Label66.Caption = "3. Karakter : " & Trim(tray!strCharID3)
    Else
    Label66.Caption = "## CHAR YOK ##"
End If
Check
tray.Open "Select * FROM TB_USER WHERE strAccountID = '" & useracc & "'", trayhoper, 1, 3
Label65.Caption = "Sifre : " & tray!strpasswd
stat "Kullanıcı " & userid & " Yuklendi !"
Check
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command1_Click
Else

End If
End Sub
Public Function stat(Durumum As String)
durum.Caption = Durumum
End Function
Public Sub sifirla()
levvel.Text = ""
nnp.Text = ""
npp.Text = ""
parra.Text = ""
text6.Text = ""
text7.Text = ""
text8.Text = ""
Text9.Text = ""
hessap.Text = ""
Text11.Text = ""
str.Text = ""
dex.Text = ""
intel.Text = ""
cha.Text = ""
magic.Text = ""
manner.Caption = ""
zoneinfo.Caption = ""
mail.Caption = ""
hesap.Caption = ""
char1.Caption = ""
char2.Caption = ""
char3.Caption = ""
para.Caption = ""
lpuan.Caption = ""
puan.Caption = ""
irk.Caption = ""
level.Caption = ""
End Sub
Private Sub p1_Click()
If p1.BackColor = vbRed Then
p1.BackColor = vbBlack
Else
p1.BackColor = vbRed
End If
End Sub
Private Sub p2_Click()
If p2.BackColor = vbRed Then
p2.BackColor = vbBlack
Else
p2.BackColor = vbRed
End If
End Sub
Private Sub p3_Click()
If p3.BackColor = vbRed Then
p3.BackColor = vbBlack
Else
p3.BackColor = vbRed
End If
End Sub
Private Sub p4_Click()
If p4.BackColor = vbRed Then
p4.BackColor = vbBlack
Else
p4.BackColor = vbRed
End If
End Sub
Private Sub p5_Click()
If p5.BackColor = vbRed Then
p5.BackColor = vbBlack
Else
p5.BackColor = vbRed
End If
End Sub
Private Sub p6_Click()
If p6.BackColor = vbRed Then
p6.BackColor = vbBlack
Else
p6.BackColor = vbRed
End If
End Sub
Private Sub p7_Click()
If p7.BackColor = vbRed Then
p7.BackColor = vbBlack
Else
p7.BackColor = vbRed
End If
End Sub
Private Sub p8_Click()
If p8.BackColor = vbRed Then
p8.BackColor = vbBlack
Else
p8.BackColor = vbRed
End If
End Sub
Private Sub p9_Click()
If p9.BackColor = vbRed Then
p9.BackColor = vbBlack
Else
p9.BackColor = vbRed
End If
End Sub
Private Sub p10_Click()
If p10.BackColor = vbRed Then
p10.BackColor = vbBlack
Else
p10.BackColor = vbRed
End If
End Sub
Private Sub p11_Click()
If p11.BackColor = vbRed Then
p11.BackColor = vbBlack
Else
p11.BackColor = vbRed
End If
End Sub
Private Sub p12_Click()
If p12.BackColor = vbRed Then
p12.BackColor = vbBlack
Else
p12.BackColor = vbRed
End If
End Sub
Private Sub p13_Click()
If p13.BackColor = vbRed Then
p13.BackColor = vbBlack
Else
p13.BackColor = vbRed
End If
End Sub
Private Sub pic14_Click()
If pic14.BackColor = vbRed Then
pic14.BackColor = vbBlack
Else
pic14.BackColor = vbRed
End If
End Sub
Private Sub pic15_Click()
If pic15.BackColor = vbRed Then
pic15.BackColor = vbBlack
Else
pic15.BackColor = vbRed
End If
End Sub
Private Sub p16_Click()
If p16.BackColor = vbRed Then
p16.BackColor = vbBlack
Else
p16.BackColor = vbRed
End If
End Sub
Private Sub p17_Click()
If p17.BackColor = vbRed Then
p17.BackColor = vbBlack
Else
p17.BackColor = vbRed
End If
End Sub
Private Sub p18_Click()
If p18.BackColor = vbRed Then
p18.BackColor = vbBlack
Else
p18.BackColor = vbRed
End If
End Sub
Private Sub p19_Click()
If p19.BackColor = vbRed Then
p19.BackColor = vbBlack
Else
p19.BackColor = vbRed
End If
End Sub
Private Sub p20_Click()
If p20.BackColor = vbRed Then
p20.BackColor = vbBlack
Else
p20.BackColor = vbRed
End If
End Sub
Private Sub p21_Click()
If p21.BackColor = vbRed Then
p21.BackColor = vbBlack
Else
p21.BackColor = vbRed
End If
End Sub
Private Sub p22_Click()
If p22.BackColor = vbRed Then
p22.BackColor = vbBlack
Else
p22.BackColor = vbRed
End If
End Sub
Private Sub p23_Click()
If p23.BackColor = vbRed Then
p23.BackColor = vbBlack
Else
p23.BackColor = vbRed
End If
End Sub
Private Sub p24_Click()
If p24.BackColor = vbRed Then
p24.BackColor = vbBlack
Else
p24.BackColor = vbRed
End If
End Sub
Private Sub p25_Click()
If p25.BackColor = vbRed Then
p25.BackColor = vbBlack
Else
p25.BackColor = vbRed
End If
End Sub
Private Sub p26_Click()
If p26.BackColor = vbRed Then
p26.BackColor = vbBlack
Else
p26.BackColor = vbRed
End If
End Sub
Private Sub p27_Click()
If p27.BackColor = vbRed Then
p27.BackColor = vbBlack
Else
p27.BackColor = vbRed
End If
End Sub
Private Sub p28_Click()
If p28.BackColor = vbRed Then
p28.BackColor = vbBlack
Else
p28.BackColor = vbRed
End If
End Sub
Private Sub Text23_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Command15_Click
End If
End Sub
Private Sub p1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '14'", trayhoper, 1, 3
p1dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p1dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p1ad = item.Caption
If Not p1izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "1) " & p1ad
p1izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
End Sub

Private Sub p2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '15'", trayhoper, 1, 3
p2dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p2dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p2ad = item.Caption
If Not p2izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "2) " & p2ad
p2izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p3_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '16'", trayhoper, 1, 3
p3dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p3dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p3ad = item.Caption
If Not p3izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "3) " & p3ad
p3izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p4_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '17'", trayhoper, 1, 3
p4dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p4dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p4ad = item.Caption
If Not p4izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "4) " & p4ad
p4izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p5_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '18'", trayhoper, 1, 3
p5dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p5dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p5ad = item.Caption
If Not p5izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "5) " & p5ad
p5izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p6_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '19'", trayhoper, 1, 3
p6dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p6dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p6ad = item.Caption
If Not p6izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "6) " & p6ad
p6izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p7_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '20'", trayhoper, 1, 3
p7dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p7dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p7ad = item.Caption
If Not p7izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "7) " & p7ad
p7izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p8_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '21'", trayhoper, 1, 3
p8dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p8dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p8ad = item.Caption
If Not p8izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "8) " & p8ad
p8izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p9_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '22'", trayhoper, 1, 3
p9dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p9dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p9ad = item.Caption
If Not p9izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "9) " & p9ad
p9izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p10_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '23'", trayhoper, 1, 3
p10dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p10dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p10ad = item.Caption
If Not p10izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "10) " & p10ad
p10izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p11_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '24'", trayhoper, 1, 3
p11dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p11dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p11ad = item.Caption
If Not p11izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "11) " & p11ad
p11izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p12_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '25'", trayhoper, 1, 3
p12dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p12dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p12ad = item.Caption
If Not p12izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "12) " & p12ad
p12izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"

End Sub
Private Sub p13_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '26'", trayhoper, 1, 3
p13dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p13dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p13ad = item.Caption
If Not p13izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "13) " & p13ad
p13izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"

End Sub
Private Sub pic14_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '27'", trayhoper, 1, 3
p1dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p1dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p14ad = item.Caption
If Not p14izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "14) " & p14ad
p14izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub pic15_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '28'", trayhoper, 1, 3
pic15dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & pic15dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p15ad = item.Caption
If Not p15izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "15) " & p15ad
p15izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p16_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '29'", trayhoper, 1, 3
p16dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p16dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p16ad = item.Caption
If Not p1izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "1) " & p1ad
p1izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p17_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '30'", trayhoper, 1, 3
p17dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p17dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p17ad = item.Caption
If Not p17izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "17) " & p17ad
p17izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p18_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '31'", trayhoper, 1, 3
p18dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p18dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p18ad = item.Caption
If Not p18izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "18) " & p18ad
p18izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p19_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '32'", trayhoper, 1, 3
p19dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p19dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p19ad = item.Caption
If Not p19izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "19) " & p19ad
p19izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"

End Sub
Private Sub p20_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '33'", trayhoper, 1, 3
p20dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p20dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p20ad = item.Caption
If Not p20izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "20) " & p20ad
p20izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p21_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '34'", trayhoper, 1, 3
p21dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p21dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p21ad = item.Caption
If Not p21izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "21) " & p21ad
p21izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p22_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '35'", trayhoper, 1, 3
p22dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p22dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p22ad = item.Caption
If Not p22izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "22) " & p22ad
p22izin = 1
End If
tray.Close

Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub


Private Sub p23_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '36'", trayhoper, 1, 3
p23dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p23dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p23ad = item.Caption
If Not p23izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "23) " & p23ad
p23izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p24_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '37'", trayhoper, 1, 3
p24dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p24dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p24ad = item.Caption
If Not p24izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "24) " & p24ad
p24izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p25_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '38'", trayhoper, 1, 3
p25dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p25dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p25ad = item.Caption
If Not p25izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "25) " & p25ad
p25izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p26_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '39'", trayhoper, 1, 3
p26dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p26dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p26ad = item.Caption
If Not p26izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "26) " & p26ad
p26izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p27_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '40'", trayhoper, 1, 3
p27dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p27dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p27ad = item.Caption
If Not p27izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "27) " & p27ad
p27izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub
Private Sub p28_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
On Error GoTo hata
Check
tray.Open "Select * FROM itemler WHERE sira = '41'", trayhoper, 1, 3
p28dwid = tray!dwid
tray.Close
tray.Open "Select * FROM ITEM WHERE Num = '" & p28dwid & "'", trayhoper, 1, 3
item.Caption = Trim(tray!strName)
p28ad = item.Caption
If Not p28izin = 1 Then
liste1.Text = liste1.Text + vbCrLf + "28) " & p28ad
p28izin = 1
End If
tray.Close
Exit Sub
hata:
item.Caption = "## ITEM YOK ##"
tray.Close
End Sub

Form Kısmı Download :
RapidShare: Easy Filehosting

Teşekkürler ..
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

aGa Teşekkürler. Bu kadar kod için kasılır mı yahu :)
2 - 3 günlük bir emek alır.
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

REIKO' Alıntı:
aGa Teşekkürler. Bu kadar kod için kasılır mı yahu :)
2 - 3 günlük bir emek alır.
Genişletmek için tıkla ...

Bende yazmadan önce o mantıkla yazmıştım ama yazarken tek tek ordan burdan hatalar çıkınca onları fixlemek insanın ömrünü alıyor :) Onu fixleyince başka bi yerden patlak veriyor hurraa yine o tarafa .. :^^:
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

tesekkürLer dosTm güzeL payLsm :)

replicektm ama daha öncdn replisin :D
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

verdüm rapini hö
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

Sağolasın burak güzel paylasım
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

teşekkürler vb öğrenmeye çalışıyorum sourceler çok işime yarayacaktır...
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

rapidshareden hata alıyorum:S

upload.com ve baska bı sıteye upluoad etsen daha guzel olurdu
 
Son düzenleme:
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

Teşekkür Ediyorum Paylaştığın için..
 
Cevap: Server Kontrol Programı v2.0 [ Visual Basic Source ]

Düzeltmeye çalışıyorum bi yerden alternatif bulursam koyucam ..
 
Cevap yazmak için giriş yap yada kayıt ol.

Online istatistikleri

Çevrimiçi kullanıcılar
1
Çevrimiçi ziyaretçiler
3,711
Toplam ziyaretçi
3,712
Toplamlar, gizli ziyaretçiler içerebilir.

About Us

Ko-Cuce.Net 2007 yılından bu yana pvp serverler tanıtım sektöründe öncü tanıtım sitesi olarak yayın hayatına devam eden bir private server forum sitesidir. 2007 yılından bu yana Ko-Cuce.Net olarak hizmet veren ve tüm oyunlara oyuncu katkısı sağlayan bir lider platform'dur Pvp Serverler iptv gamers4life metin2 pvp Knight Online Pvp

silkroad private server

En yeni üyeler

Stay Connected

Geri
Üst Alt