وقتی میخوام برناممو اجرا کنم همچین خطایی میده.بااینکه من توی دیتابیسم این ستون رو دارم،ولی بازم این خطا هی تکرار میشه.
ممنون میشم اگه کسی بتونه کمک کنه
این اکت دیتابیسم:
'Class module Sub Class_Globals Dim sql1 As SQL Type tGroup(Sgroup As String,Simage As String) Type fGroup(Sgroup1 As String,Simage1 As String) Type tSMS(Sid As Int,Scontent As String,Sread As Int, Sstar As Int) End Sub
'Initializes the object. You can add parameters to this method if needed. Public Sub Initialize If File.Exists(File.DirInternal,"SMS.db")= False Then File.Copy(File.DirAssets,"SMS.db",File.DirInternal,"SMS.db") End If sql1.Initialize(File.DirInternal,"SMS.db",False) End Sub
Sub listGroup As List Dim cur As Cursor Dim list1 As List
list1.Initialize cur = sql1.ExecQuery("SELECT Sgroup,(SELECT Simage FROM tblImage WHERE Sgroup = tblSMS.Sgroup) as Simage from tblSMS GROUP BY Sgroup")
For i=0 To cur.RowCount-1 cur.Position = i Dim t1 As tGroup t1.Initialize t1.Sgroup = cur.GetString("Sgroup") t1.Simage = cur.GetString("Simage") list1.Add(t1) Next
Return list1 End Sub '//////////////////////////////////////////////////////////////
Sub listGroup12 As List Dim cur As Cursor Dim list12 As List
list12.Initialize cur = sql1.ExecQuery("SELECT Sgroup1 from tblSMS GROUP BY Sgroup1")
For i=0 To cur.RowCount-1 cur.Position = i Dim t1 As fGroup t1.Initialize t1.Sgroup1 = cur.GetString("Sgroup1") t1.Simage1 = cur.GetString("Simage1") list12.Add(t1) Next
Return list12 End Sub
'////////////////////////////////////////////////////////////////////////// Sub listsubGroup(groupName As String) As List Dim cur As Cursor Dim list1 As List Dim list12 As List Dim cur2 As Cursor
list1.Initialize cur = sql1.ExecQuery("SELECT * from tblSMS where Sgroup = '"&groupName&"'") cur2 = sql1.ExecQuery("SELECT * from tblSMS where Sgroup1 = '"&groupName&"'") For i=0 To cur.RowCount-1 cur.Position = i Dim t1 As tSMS t1.Initialize t1.Sid = cur.GetInt("Sid") t1.Scontent = cur.GetString("Scontent") t1.Sread = cur.GetInt("Sread") t1.Sstar = cur.GetInt("Sstar") list1.Add(t1) Next
Return list1 End Sub
Sub changeRead(Sid As String , Sread As Int) As Boolean If Sid="" Then Return False End If sql1.ExecNonQuery2("update tblSMS set Sread = ? where Sid = ?",Array As String(Sread,Sid)) Return True End Sub
Sub changeStar(Sid As String , SRate As Int) As Boolean If Sid="" Then Return False End If sql1.ExecNonQuery2("update tblSMS set Sstar = ? where Sid = ?",Array As String(SRate,Sid)) Return True End Sub
Sub getSMS(Sid As String) As tSMS Dim cur As Cursor cur = sql1.ExecQuery2("select * from tblSMS where Sid = ?",Array As String (Sid)) cur.Position = 0 Dim t1 As tSMS t1.Initialize t1.Scontent = cur.GetString("Scontent") t1.Sid = cur.GetInt("Sid") t1.Sread = cur.GetInt("Sread") t1.Sstar = cur.GetInt("Sstar")
Return t1 End Sub
Sub searchItem(str As String) As List Dim cur As Cursor Dim list1 As List
list1.Initialize cur = sql1.ExecQuery("select * from tblSMS where Scontent LIKE '%"&str&"%'")
For i =0 To cur.RowCount - 1 cur.Position = i Dim t1 As tSMS t1.Initialize
Sub subGroupShow_Click Dim v1 As View v1 = Sender 'Msgbox(v1.Tag,"") actGroup.vGroupName = v1.Tag StartActivity(actGroup) End Sub Sub btnSearch_Click lblMain.Visible = False pnlSearch.Visible =True End Sub Sub txtSearch_EnterPressed If txtSearch.Text="" Then ToastMessageShow("لطفا عبارت جستجو را وارد کنید",False) Return Else Dim l1 As List l1.Initialize l1 = db.searchItem(txtSearch.Text) actGroup.search = l1 StartActivity(actGroup) End If End Sub
Sub Activity_KeyPress (KeyCode As Int) As Boolean 'Return True to consume the event If KeyCode = KeyCodes.KEYCODE_MENU Then If slide.Visible = False Then slide.ShowMenu Else slide.HideMenus End If Return True End If End Sub
Sub panelMenu_ItemClick (Position As Int,Value As Object) Select Value Case "contact" StartActivity(actContact) Case "about" Dim c1 As CustomDialog Dim p1 As Panel p1.Initialize("") c1.AddView(p1,0,0,492,260) p1.LoadLayout("Labout") c1.Show("درباره ما","خب","","",Null) Case "setting" setting Case "update" updateApp Case "idea" myLibrary.OpenBazaarApp("com.mojtaba.daneshjooyar",True) Case "product" Dim ph As PhoneIntents StartActivity(ph.OpenBrowser("http://cafebazar.ir/search/?1=&q=سپهر")) Case "exit" If Msgbox2("آیا می خواهید از برنامه خارج شوید؟","خروج","بله","خیر","",Null) = DialogResponse.POSITIVE Then Activity.Finish ExitApplication End If End Select End Sub
Sub setting Dim a1 As AHPreferenceScreen a1.Initialize("تنظیمات","تنظیمات مربوط به نمایش") a1.AddList("fontSize","اندازه قلم","حالت پیشفرض سایز قلم 18","18","",Array As String("20","21","22","28","36","40","52")) a1.AddList("fontColor","رنگ قلم","رنگ پیشفرض قلم سیاه است","black","",Array As String("Red","Green","Blue","Yellow")) a1.AddList("fontFamily","نوع قلم","","byekan.ttf","",Array As String("tahoma.ttf","bn.ttf"))
StartActivity(a1.CreateIntent) End Sub
Sub updateApp If myLibrary.CheckInternet = False Then ToastMessageShow("لطفا به اینترنت متصب شوید",False) Return End If
Dim ht As HttpJob ht.Initialize("update",Me) ProgressDialogShow("در حال دانلود") ht.Download("http://s5.picofile.com/file/8152747592/SMS.db.html") End Sub
Sub JobDone(Job As HttpJob) ProgressDialogHide If Job.Success = True Then Dim out As OutputStream
Dim oldCount,newCount As String Dim db1 As myDB db1.Initialize oldCount = db1.SMSCount
File.Delete(File.DirInternal,"SMS.db") out = File.OpenOutput(File.DirInternal,"SMS.db",False) File.Copy2(Job.GetInputStream,out) out.Close
Dim db2 As myDB db2.Initialize newCount= db2.SMSCount
ToastMessageShow("برنامه با موفقیت بروزرسانی شد" &CRLF& "تعداد پیامک های جدید :" &(newCount - oldCount),False) Else ToastMessageShow("خطا در برنامه",False) End If End Sub
سوال
amirjun32 105
وقتی میخوام برناممو اجرا کنم همچین خطایی میده.بااینکه من توی دیتابیسم این ستون رو دارم،ولی بازم این خطا هی تکرار میشه.
ممنون میشم اگه کسی بتونه کمک کنه
این اکت دیتابیسم:
'Class module
Sub Class_Globals
Dim sql1 As SQL
Type tGroup(Sgroup As String,Simage As String)
Type fGroup(Sgroup1 As String,Simage1 As String)
Type tSMS(Sid As Int,Scontent As String,Sread As Int, Sstar As Int)
End Sub
'Initializes the object. You can add parameters to this method if needed.
Public Sub Initialize
If File.Exists(File.DirInternal,"SMS.db")= False Then
File.Copy(File.DirAssets,"SMS.db",File.DirInternal,"SMS.db")
End If
sql1.Initialize(File.DirInternal,"SMS.db",False)
End Sub
Sub listGroup As List
Dim cur As Cursor
Dim list1 As List
list1.Initialize
cur = sql1.ExecQuery("SELECT Sgroup,(SELECT Simage FROM tblImage WHERE Sgroup = tblSMS.Sgroup) as Simage from tblSMS GROUP BY Sgroup")
For i=0 To cur.RowCount-1
cur.Position = i
Dim t1 As tGroup
t1.Initialize
t1.Sgroup = cur.GetString("Sgroup")
t1.Simage = cur.GetString("Simage")
list1.Add(t1)
Next
Return list1
End Sub
'//////////////////////////////////////////////////////////////
Sub listGroup12 As List
Dim cur As Cursor
Dim list12 As List
list12.Initialize
cur = sql1.ExecQuery("SELECT Sgroup1 from tblSMS GROUP BY Sgroup1")
For i=0 To cur.RowCount-1
cur.Position = i
Dim t1 As fGroup
t1.Initialize
t1.Sgroup1 = cur.GetString("Sgroup1")
t1.Simage1 = cur.GetString("Simage1")
list12.Add(t1)
Next
Return list12
End Sub
'//////////////////////////////////////////////////////////////////////////
Sub listsubGroup(groupName As String) As List
Dim cur As Cursor
Dim list1 As List
Dim list12 As List
Dim cur2 As Cursor
list1.Initialize
cur = sql1.ExecQuery("SELECT * from tblSMS where Sgroup = '"&groupName&"'")
cur2 = sql1.ExecQuery("SELECT * from tblSMS where Sgroup1 = '"&groupName&"'")
For i=0 To cur.RowCount-1
cur.Position = i
Dim t1 As tSMS
t1.Initialize
t1.Sid = cur.GetInt("Sid")
t1.Scontent = cur.GetString("Scontent")
t1.Sread = cur.GetInt("Sread")
t1.Sstar = cur.GetInt("Sstar")
list1.Add(t1)
Next
Return list1
End Sub
Sub changeRead(Sid As String , Sread As Int) As Boolean
If Sid="" Then
Return False
End If
sql1.ExecNonQuery2("update tblSMS set Sread = ? where Sid = ?",Array As String(Sread,Sid))
Return True
End Sub
Sub changeStar(Sid As String , SRate As Int) As Boolean
If Sid="" Then
Return False
End If
sql1.ExecNonQuery2("update tblSMS set Sstar = ? where Sid = ?",Array As String(SRate,Sid))
Return True
End Sub
Sub getSMS(Sid As String) As tSMS
Dim cur As Cursor
cur = sql1.ExecQuery2("select * from tblSMS where Sid = ?",Array As String (Sid))
cur.Position = 0
Dim t1 As tSMS
t1.Initialize
t1.Scontent = cur.GetString("Scontent")
t1.Sid = cur.GetInt("Sid")
t1.Sread = cur.GetInt("Sread")
t1.Sstar = cur.GetInt("Sstar")
Return t1
End Sub
Sub searchItem(str As String) As List
Dim cur As Cursor
Dim list1 As List
list1.Initialize
cur = sql1.ExecQuery("select * from tblSMS where Scontent LIKE '%"&str&"%'")
For i =0 To cur.RowCount - 1
cur.Position = i
Dim t1 As tSMS
t1.Initialize
t1.Scontent = cur.GetString("Scontent")
t1.Sid = cur.GetInt("Sid")
t1.Sread = cur.GetInt("Sread")
t1.Sstar = cur.GetInt("Sstar")
list1.Add(t1)
Next
Return list1
End Sub
Sub getSMSCount As String
Dim s1 As String
s1 = sql1.ExecQuerySingleResult("select COUNT(*) from tblSMS")
Return s1
End Sub
اینم اکت گروهم:
#Region Activity Attributes
#FullScreen: False
#IncludeTitle: False
#End Region
Sub Process_Globals
End Sub
Sub Globals
Dim db As myDB
Dim list12 As List
Dim scrol1 As CustomListView
Private pnlMain As Panel
Private imgGroup As ImageView
Private lblGroup As Label
Private btnSearch As Button
Private txtSearch As EditText
Private pnlSearch As Panel
Private lblMain As Label
Dim slide As SlidingMenu
Private Panel2 As Panel
End Sub
Sub Activity_Create(FirstTime As Boolean)
Activity.LoadLayout("LMai")
myLibrary.createMenu(slide)
db.Initialize
list12.Initialize
list12 = db.listGroup12
scrol1.Initialize(Me,"scrol1Event")
pnlMain.AddView(scrol1.AsView,0,52dip, 100%x,100%y-Panel2.Height)
For i=0 To list12.Size - 1
Dim p1 As Panel
p1.Initialize("")
scrol1.Add(p1,140dip,"")
p1.LoadLayout("LPGroup1")
Dim t1 As fGroup
t1.Initialize
t1 = list12.Get(i)
lblGroup.Text = t1.Sgroup1
imgGroup.SetBackgroundImage(LoadBitmap(File.DirAssets,t1.Simage1))
lblGroup.Tag = t1.Sgroup1
imgGroup.Tag = t1.Sgroup1
Next
End Sub
Sub Activity_Resume
End Sub
Sub Activity_Pause (UserClosed As Boolean)
End Sub
Sub subGroupShow_Click
Dim v1 As View
v1 = Sender
'Msgbox(v1.Tag,"")
actGroup.vGroupName = v1.Tag
StartActivity(actGroup)
End Sub
Sub btnSearch_Click
lblMain.Visible = False
pnlSearch.Visible =True
End Sub
Sub txtSearch_EnterPressed
If txtSearch.Text="" Then
ToastMessageShow("لطفا عبارت جستجو را وارد کنید",False)
Return
Else
Dim l1 As List
l1.Initialize
l1 = db.searchItem(txtSearch.Text)
actGroup.search = l1
StartActivity(actGroup)
End If
End Sub
Sub Activity_KeyPress (KeyCode As Int) As Boolean 'Return True to consume the event
If KeyCode = KeyCodes.KEYCODE_MENU Then
If slide.Visible = False Then
slide.ShowMenu
Else
slide.HideMenus
End If
Return True
End If
End Sub
Sub panelMenu_ItemClick (Position As Int,Value As Object)
Select Value
Case "contact"
StartActivity(actContact)
Case "about"
Dim c1 As CustomDialog
Dim p1 As Panel
p1.Initialize("")
c1.AddView(p1,0,0,492,260)
p1.LoadLayout("Labout")
c1.Show("درباره ما","خب","","",Null)
Case "setting"
setting
Case "update"
updateApp
Case "idea"
myLibrary.OpenBazaarApp("com.mojtaba.daneshjooyar",True)
Case "product"
Dim ph As PhoneIntents
StartActivity(ph.OpenBrowser("http://cafebazar.ir/search/?1=&q=سپهر"))
Case "exit"
If Msgbox2("آیا می خواهید از برنامه خارج شوید؟","خروج","بله","خیر","",Null) = DialogResponse.POSITIVE Then
Activity.Finish
ExitApplication
End If
End Select
End Sub
Sub setting
Dim a1 As AHPreferenceScreen
a1.Initialize("تنظیمات","تنظیمات مربوط به نمایش")
a1.AddList("fontSize","اندازه قلم","حالت پیشفرض سایز قلم 18","18","",Array As String("20","21","22","28","36","40","52"))
a1.AddList("fontColor","رنگ قلم","رنگ پیشفرض قلم سیاه است","black","",Array As String("Red","Green","Blue","Yellow"))
a1.AddList("fontFamily","نوع قلم","","byekan.ttf","",Array As String("tahoma.ttf","bn.ttf"))
StartActivity(a1.CreateIntent)
End Sub
Sub updateApp
If myLibrary.CheckInternet = False Then
ToastMessageShow("لطفا به اینترنت متصب شوید",False)
Return
End If
Dim ht As HttpJob
ht.Initialize("update",Me)
ProgressDialogShow("در حال دانلود")
ht.Download("http://s5.picofile.com/file/8152747592/SMS.db.html")
End Sub
Sub JobDone(Job As HttpJob)
ProgressDialogHide
If Job.Success = True Then
Dim out As OutputStream
Dim oldCount,newCount As String
Dim db1 As myDB
db1.Initialize
oldCount = db1.SMSCount
File.Delete(File.DirInternal,"SMS.db")
out = File.OpenOutput(File.DirInternal,"SMS.db",False)
File.Copy2(Job.GetInputStream,out)
out.Close
Dim db2 As myDB
db2.Initialize
newCount= db2.SMSCount
ToastMessageShow("برنامه با موفقیت بروزرسانی شد" &CRLF& "تعداد پیامک های جدید :" &(newCount - oldCount),False)
Else
ToastMessageShow("خطا در برنامه",False)
End If
End Sub
لینک ارسال
به اشتراک گذاری در سایت های دیگر
3 پاسخ به این سوال تاکنون داده شده است
ارسالهای توصیه شده
بایگانی شده
این موضوع بایگانی و قفل شده و دیگر امکان ارسال پاسخ نیست.