Drop List Maker [ Otomatik Drop Listesi ] + [ Source ]

tarafından **Hello EMO** Çarş. Kas. 25, 2009 3:13 am

Kod:: '##################################################' '#### Trayhoper's Drop List Maker Source Codes ####' '#### 25.09.2008 Perşembe .. zzz Hasta Oldum ! ####' '##################################################' Private Declare Sub Sleep Lib "kernel32" _ (ByVal dwMilliseconds As Long) Dim conn As New ADODB.Connection Dim conn2 As New ADODB.Connection Dim conn3 As New ADODB.Connection Dim tray As New ADODB.Recordset Dim tray2 As New ADODB.Recordset Dim tray3 As New ADODB.Recordset Dim genelveri As String Dim canavar, item1, item2, item3, item4, item5 As String Dim CanavarAd, item1ad, item2ad, item3ad, item4ad, item5ad As String Dim oran1, oran2, oran3, oran4, oran5 As String Dim ItemAdi As String Public Sub baglan(Veritabani As String) On Error GoTo hata If conn.State = 1 Then conn.Close End If conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Veritabani & " " genelveri = Veritabani Exit Sub hata: MsgBox "Database : " & Veritabani & " bağlanılamadı ..", vbCritical End End Sub Public Sub baglan2(Veritabani As String) On Error GoTo hata If conn2.State = 1 Then conn2.Close End If conn2.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Veritabani & " " Exit Sub hata: MsgBox "Database : " & Veritabani & " bağlanılamadı ..", vbCritical End End Sub Public Sub baglan3(Veritabani As String) On Error GoTo hata If conn3.State = 1 Then MsgBox "Zaten bir bağlantı açık !", vbCritical conn3.Close End If conn3.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Veritabani & " " Exit Sub hata: MsgBox "Database : " & Veritabani & " bağlanılamadı ..", vbCritical End End Sub Private Sub Command1_Click() baglan Text1.Text baglan2 Text1.Text baglan3 Text1.Text Sleep 1000 Drop End Sub Private Sub Text1_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Command1_Click End If End Sub Public Sub IsimBul(CanavarIndex As String) On Error GoTo hata Check2 tray2.Open "Select strName FROM K_MONSTER WHERE sSid = '" & CanavarIndex & "'", conn2, 1, 3 CanavarAd = tray2!strName Exit Sub hata: conn2.Execute "DELETE FROM K_MONSTER_ITEM WHERE sIndex = '" & CanavarIndex & "'" End Sub Public Sub ItemBul(ItemIndex As String) On Error Resume Next Check3 If Int(Trim(ItemIndex)) = "0" Then ItemAdi = "Drop Yok !" Exit Sub End If If Int(Trim(ItemIndex)) < Int(1000000) Then ItemAdi = "Rasgele Item" Exit Sub End If tray3.Open "Select strName FROM ITEM WHERE Num = '" & ItemIndex & "'", conn3, 1, 3 ItemAdi = tray3!strName End Sub Public Sub Drop() tray.Open "Select * FROM K_MONSTER_ITEM", conn, 1, 3 Do Until tray.EOF canavar = tray!sIndex item1 = tray!iItem01 item2 = tray!iItem02 item3 = tray!iItem03 item4 = tray!iItem04 item5 = tray!iItem05 oran1 = Int(Int(tray!sPersent01) / Int(100)) oran2 = Int(Int(tray!sPersent02) / Int(100)) oran3 = Int(Int(tray!sPersent03) / Int(100)) oran4 = Int(Int(tray!sPersent04) / Int(100)) oran5 = Int(Int(tray!sPersent05) / Int(100)) IsimBul "" & canavar & "" List1.AddItem "** " & CanavarAd & " **" CanavarAd = vbNullString ItemBul "" & item1 & "" List1.AddItem "" List1.AddItem "1) " & Trim(ItemAdi) & " %" & oran1 & "" ItemAdi = vbNullString ItemBul "" & item2 & "" List1.AddItem "2) " & Trim(ItemAdi) & " %" & oran2 & "" ItemAdi = vbNullString ItemBul "" & item3 & "" List1.AddItem "3) " & Trim(ItemAdi) & " %" & oran3 & "" ItemAdi = vbNullString ItemBul "" & item4 & "" List1.AddItem "4) " & Trim(ItemAdi) & " %" & oran4 & "" ItemAdi = vbNullString ItemBul "" & item5 & "" List1.AddItem "5) " & Trim(ItemAdi) & " %" & oran4 & "" List1.AddItem "" ItemAdi = vbNullString tray.MoveNext Loop ListeKayit List1 MsgBox "Kayıt Edildi : " & App.Path & "\" & genelveri & ".txt" End End Sub Public Sub Check() If tray.State = 1 Then tray.Close End If End Sub Public Sub Check3() If tray3.State = 1 Then tray3.Close End If End Sub Public Sub Check2() If tray2.State = 1 Then tray2.Close End If End Sub Private Sub ListeKayit(Liste As ListBox) Dim Sayac% Open App.Path & "\" & genelveri & ".txt" For Output As #1 For Sayac = 0 To Liste.ListCount - 1 Print #1, Liste.List(Sayac) Next Sayac Close #1 End Sub