1. '##################################################'
   
2. '####  Drop List Maker Source Codes ####'
   
3. '#### 03.11.2008 kofans.cn! ####'
   
4. '##################################################'
   
5. Private Declare Sub Sleep Lib "kernel32" _
   
6. (ByVal dwMilliseconds As Long)
   
7. Dim conn As New ADODB.Connection
   
8. Dim conn2 As New ADODB.Connection
   
9. Dim conn3 As New ADODB.Connection
   
10. Dim tray As New ADODB.Recordset
    
11. Dim tray2 As New ADODB.Recordset
    
12. Dim tray3 As New ADODB.Recordset
    
13. Dim genelveri As String
    
14. Dim canavar, item1, item2, item3, item4, item5 As String
    
15. Dim CanavarAd, item1ad, item2ad, item3ad, item4ad, item5ad As String
    
16. Dim oran1, oran2, oran3, oran4, oran5 As String
    
17. Dim ItemAdi As String
    
18. Public Sub baglan(Veritabani As String)
    
19. On Error GoTo hata
    
20. If conn.State = 1 Then
    
21. conn.Close
    
22. End If
    
23. conn.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Veritabani & " "
    
24. genelveri = Veritabani
    
25. Exit Sub
    
26. hata:
    
27. MsgBox "Database : " & Veritabani & " bağlanılamadı ..", vbCritical
    
28. End
    
29. End Sub
    
30. Public Sub baglan2(Veritabani As String)
    
31. On Error GoTo hata
    
32. If conn2.State = 1 Then
    
33. conn2.Close
    
34. End If
    
35. conn2.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Veritabani & " "
    
36. Exit Sub
    
37. hata:
    
38. MsgBox "Database : " & Veritabani & " bağlanılamadı ..", vbCritical
    
39. End
    
40. End Sub
    
41. Public Sub baglan3(Veritabani As String)
    
42. On Error GoTo hata
    
43. If conn3.State = 1 Then
    
44. MsgBox "Zaten bir bağlantı açık !", vbCritical
    
45. conn3.Close
    
46. End If
    
47. conn3.Open "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;Initial Catalog=" & Veritabani & " "
    
48. Exit Sub
    
49. hata:
    
50. MsgBox "Database : " & Veritabani & " bağlanılamadı ..", vbCritical
    
51. End
    
52. End Sub
    
53. Private Sub Command1_Click()
    
54. baglan Text1.Text
    
55. baglan2 Text1.Text
    
56. baglan3 Text1.Text
    
57. Sleep 1000
    
58. Drop
    
59. End Sub
    
60. 
    
61. Private Sub Text1_KeyPress(KeyAscii As Integer)
    
62. If KeyAscii = 13 Then
    
63. Command1_Click
    
64. End If
    
65. End Sub
    
66. Public Sub IsimBul(CanavarIndex As String)
    
67. On Error GoTo hata
    
68. Check2
    
69. tray2.Open "Select strName FROM K_MONSTER WHERE sSid = '" & CanavarIndex & "'", conn2, 1, 3
    
70. CanavarAd = tray2!strName
    
71. Exit Sub
    
72. hata:
    
73. conn2.Execute "DELETE FROM K_MONSTER_ITEM WHERE sIndex = '" & CanavarIndex & "'"
    
74. End Sub
    
75. Public Sub ItemBul(ItemIndex As String)
    
76. On Error Resume Next
    
77. Check3
    
78. If Int(Trim(ItemIndex)) = "0" Then
    
79.     ItemAdi = "Drop Yok !"
    
80.     Exit Sub
    
81. End If
    
82. If Int(Trim(ItemIndex)) < Int(1000000) Then
    
83.     ItemAdi = "Rasgele Item"
    
84.     Exit Sub
    
85. End If
    
86. tray3.Open "Select strName FROM ITEM WHERE Num = '" & ItemIndex & "'", conn3, 1, 3
    
87. ItemAdi = tray3!strName
    
88. End Sub
    
89. Public Sub Drop()
    
90. tray.Open "Select * FROM K_MONSTER_ITEM", conn, 1, 3
    
91. Do Until tray.EOF
    
92.     canavar = tray!sIndex
    
93.     item1 = tray!iItem01
    
94.     item2 = tray!iItem02
    
95.     item3 = tray!iItem03
    
96.     item4 = tray!iItem04
    
97.     item5 = tray!iItem05
    
98.     oran1 = Int(Int(tray!sPersent01) / Int(100))
    
99.     oran2 = Int(Int(tray!sPersent02) / Int(100))
    
100.     oran3 = Int(Int(tray!sPersent03) / Int(100))
     
101.     oran4 = Int(Int(tray!sPersent04) / Int(100))
     
102.     oran5 = Int(Int(tray!sPersent05) / Int(100))
     
103.     IsimBul "" & canavar & ""
     
104.     List1.AddItem "** " & CanavarAd & " **"
     
105.     CanavarAd = vbNullString
     
106.     ItemBul "" & item1 & ""
     
107.     List1.AddItem ""
     
108.     List1.AddItem "1) " & Trim(ItemAdi) & "   %" & oran1 & ""
     
109.     ItemAdi = vbNullString
     
110.     ItemBul "" & item2 & ""
     
111.     List1.AddItem "2) " & Trim(ItemAdi) & "    %" & oran2 & ""
     
112.     ItemAdi = vbNullString
     
113.     ItemBul "" & item3 & ""
     
114.     List1.AddItem "3) " & Trim(ItemAdi) & "    %" & oran3 & ""
     
115.     ItemAdi = vbNullString
     
116.     ItemBul "" & item4 & ""
     
117.     List1.AddItem "4) " & Trim(ItemAdi) & "    %" & oran4 & ""
     
118.     ItemAdi = vbNullString
     
119.     ItemBul "" & item5 & ""
     
120.     List1.AddItem "5) " & Trim(ItemAdi) & "    %" & oran4 & ""
     
121.     List1.AddItem ""
     
122.     ItemAdi = vbNullString
     
123.    tray.MoveNext
     
124. Loop
     
125. ListeKayit List1
     
126. MsgBox "Kay&#305;t Edildi : " & App.Path & "" & genelveri & ".txt"
     
127. End
     
128. End Sub
     
129. Public Sub Check()
     
130. If tray.State = 1 Then
     
131. tray.Close
     
132. End If
     
133. End Sub
     
134. Public Sub Check3()
     
135. If tray3.State = 1 Then
     
136. tray3.Close
     
137. End If
     
138. End Sub
     
139. Public Sub Check2()
     
140. If tray2.State = 1 Then
     
141. tray2.Close
     
142. End If
     
143. End Sub
     
144. Private Sub ListeKayit(Liste As ListBox)
     
145. Dim Sayac%
     
146. Open App.Path & "" & genelveri & ".txt" For Output As #1
     
147. For Sayac = 0 To Liste.ListCount - 1
     
148. Print #1, Liste.List(Sayac)
     
149. Next Sayac
     
150. Close #1
     
151. End Sub

复制代码

VB。。。？