ROSTAM2
شنبه 19 آبان 1403, 05:32 صبح
سلام
من برای زمانی که یک آیتم قراره به جدول اضافه بشه محدودیت بر اساس ID ایجاد کردم:
متود اضافه کردن رکورد به جدول AppProjects:
Friend Shared Sub AddProject()
Console.Clear()
Dim Project = New AppProjects
Dim PInfo As PropertyInfo = Nothing
ReStart: Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine("{0} Add New Project Information: ", vbTab)
Console.WriteLine()
For Each Field As String In SortedFieldNames
PInfo = GetType(AppProjects).GetProperty(Field)
Console.ForegroundColor = ConsoleColor.Gray
Value = PInfo.Name
FillName(Value, 20)
Console.Write(" {0}: ", Value)
Console.ForegroundColor = ConsoleColor.Green
Value = Console.ReadLine
Select Case PInfo.Name.ToLower
Case "id"
If Value.Length = 0 Then
GoTo noAdd
End If
If ExistsProject(Value.Trim) = True Then
If TryAgainQuestionForExistItem("Project", Value.Trim) = False Then GoTo noAdd
GoTo ReStart
End If
End Select
If Value.Length = 0 Then Continue For
PInfo.SetValue(Project, Value, New Object() {})
Next
ApplicationData.Projects.AddToAppProjects(Project)
ApplicationData.Projects.SaveChanges()
noAdd:
Console.Clear()
End Sub
Public Shared ReadOnly Property SortedFieldNames() As String()
Get
Dim Expr As String() =
{"Id", "Title", "Category", "ProjectType", "Language",
"StartDate", "ComputerName", "Solution",
"Package", "Password", "Details", "EndDate"}
Return Expr
End Get
End Property
Sub FillName(ByRef value As String, MaxLen As Integer)
If value.Length > MaxLen Then MaxLen = value.Length
Dim Expr As String = StrDup(MaxLen - value.Length, Space(1))
value = value.Insert(0, Expr)
End Sub
Sub WriteField(Name As String, value As String, Optional MaximumLen As Integer = 9)
FillName(Name, MaximumLen)
Console.ForegroundColor = ConsoleColor.Green
Console.Write("{0} {1}: ", vbTab, Name)
Console.ForegroundColor = ConsoleColor.White
Console.WriteLine("{0}", value)
End Sub
این متود زمانی که ID رو دریافت می کنه چک می کنه توی جدول موجود هست یا نه در صورتی که وجود داشته باشه از متود TryAgainQuestionForExistItem برای در یافت پاسخ انجام دوباره گرفتن ID استفاده می شه:
Function TryAgainQuestionForExistItem(ItemName As String, ID As Object) As Boolean
Console.Clear()
Console.WriteLine()
Console.ForegroundColor = ConsoleColor.Red
Console.WriteLine("{0} {1} already Exists, with same ID: ({2})!", vbTab, ItemName, ID)
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine("{0} Do you want to try again?", vbTab)
Console.ForegroundColor = ConsoleColor.White
Console.Write("{0} Type Y[es] to Accept: ", vbTab)
Console.ForegroundColor = ConsoleColor.Gray
Value = Console.ReadLine
'If Value.Length = 0 Then Return False
Select Case Value.Trim.ToLower
Case "y", "yes"
Console.Clear()
Return True
Case Else
Return False
End Select
End Function
اگر پاسخ Y یا Yes باشه مجددا به شروع دستور بر می گرده در غیر این صورت از دستور خارج می شه....
TryAgainQuestionForExistItem - DEV Community (https://dev.to/vblover_programmer/tryagainquestionforexistitem-l3m)
156272
ویدیوی آموزشی در سایت آپارات:
https://aparat.com/v/dvbe180 (https://aparat.com/v/dvbe180)
من برای زمانی که یک آیتم قراره به جدول اضافه بشه محدودیت بر اساس ID ایجاد کردم:
متود اضافه کردن رکورد به جدول AppProjects:
Friend Shared Sub AddProject()
Console.Clear()
Dim Project = New AppProjects
Dim PInfo As PropertyInfo = Nothing
ReStart: Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine("{0} Add New Project Information: ", vbTab)
Console.WriteLine()
For Each Field As String In SortedFieldNames
PInfo = GetType(AppProjects).GetProperty(Field)
Console.ForegroundColor = ConsoleColor.Gray
Value = PInfo.Name
FillName(Value, 20)
Console.Write(" {0}: ", Value)
Console.ForegroundColor = ConsoleColor.Green
Value = Console.ReadLine
Select Case PInfo.Name.ToLower
Case "id"
If Value.Length = 0 Then
GoTo noAdd
End If
If ExistsProject(Value.Trim) = True Then
If TryAgainQuestionForExistItem("Project", Value.Trim) = False Then GoTo noAdd
GoTo ReStart
End If
End Select
If Value.Length = 0 Then Continue For
PInfo.SetValue(Project, Value, New Object() {})
Next
ApplicationData.Projects.AddToAppProjects(Project)
ApplicationData.Projects.SaveChanges()
noAdd:
Console.Clear()
End Sub
Public Shared ReadOnly Property SortedFieldNames() As String()
Get
Dim Expr As String() =
{"Id", "Title", "Category", "ProjectType", "Language",
"StartDate", "ComputerName", "Solution",
"Package", "Password", "Details", "EndDate"}
Return Expr
End Get
End Property
Sub FillName(ByRef value As String, MaxLen As Integer)
If value.Length > MaxLen Then MaxLen = value.Length
Dim Expr As String = StrDup(MaxLen - value.Length, Space(1))
value = value.Insert(0, Expr)
End Sub
Sub WriteField(Name As String, value As String, Optional MaximumLen As Integer = 9)
FillName(Name, MaximumLen)
Console.ForegroundColor = ConsoleColor.Green
Console.Write("{0} {1}: ", vbTab, Name)
Console.ForegroundColor = ConsoleColor.White
Console.WriteLine("{0}", value)
End Sub
این متود زمانی که ID رو دریافت می کنه چک می کنه توی جدول موجود هست یا نه در صورتی که وجود داشته باشه از متود TryAgainQuestionForExistItem برای در یافت پاسخ انجام دوباره گرفتن ID استفاده می شه:
Function TryAgainQuestionForExistItem(ItemName As String, ID As Object) As Boolean
Console.Clear()
Console.WriteLine()
Console.ForegroundColor = ConsoleColor.Red
Console.WriteLine("{0} {1} already Exists, with same ID: ({2})!", vbTab, ItemName, ID)
Console.ForegroundColor = ConsoleColor.Yellow
Console.WriteLine("{0} Do you want to try again?", vbTab)
Console.ForegroundColor = ConsoleColor.White
Console.Write("{0} Type Y[es] to Accept: ", vbTab)
Console.ForegroundColor = ConsoleColor.Gray
Value = Console.ReadLine
'If Value.Length = 0 Then Return False
Select Case Value.Trim.ToLower
Case "y", "yes"
Console.Clear()
Return True
Case Else
Return False
End Select
End Function
اگر پاسخ Y یا Yes باشه مجددا به شروع دستور بر می گرده در غیر این صورت از دستور خارج می شه....
TryAgainQuestionForExistItem - DEV Community (https://dev.to/vblover_programmer/tryagainquestionforexistitem-l3m)
156272
ویدیوی آموزشی در سایت آپارات:
https://aparat.com/v/dvbe180 (https://aparat.com/v/dvbe180)