Konu Yazar
TrayhopeR
www.trayhoper.net
- May
- 2,830
- 62
1 ) Açıyosunuz ..
2 ) Veritabanı adını yazıyorsunuz ..
3 ) Oluştura basıyorsunuz ..
4 ) Yayınlıyorsunuz ..
5 ) Içinizden geldiği gibi yaşamaya devam ediyorsunuz ..
DOWNLOAD : http://rapidshare.de/files/40948441/Drop_List_Maker.rar.html
Çok özen göstermedim .. Kaynak kodları :
Kod:
[b]
'##################################################'
'#### Trayhoper's Drop List Maker Source Codes ####'
'#### 25.09.2021 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
[/b]Zaygı ve Zevgüler hö
Son düzenleme:
