Курсовая работа: Создание базы данных

3383 ' проверка на наличие индекса таблицы

3384 p = InStr(1, str, ",")

3385 tableindex% = - 1

3386 If (p <> 0) Then

3387 tableindexstr$ = Trim(Mid(str, p + 1))

3388 If Not IsInteger(tableindexstr) Then

3389 Call ErrorInQuery

3390 Exit Sub

3391 End If

3392 tableindex% = CLng(tableindexstr)

3393 If (tableindex < 0) Or (tableindex > MainForm. TabStrip. Tabs. Count - 1) Then

3394 Call ErrorInQuery

3395 Exit Sub

3396 End If

3397 str = Trim(Left(str, p - 1))

3398 End If

3399

3400 Dim GlobEqual As Boolean

3401 If (Not IsInteger(str)) And (DB(QRDBIndex). Cols(whatint). Class = ccInteger) Then

3402 Call MsgForm. ErrorMsg("Эквивалентом вывода целочисленного столбца не является целое число! " + vbCrLf + _

3403 "Условие всегда истинно! ")

3404 GlobEqual = True

3405 Else

3406 GlobEqual = False

3407 End If

3408

3409 Count% = MainForm. TabStrip. Tabs. Count

3410 If (tableindex = - 1) Then

3411 ReDim Preserve DB(Count)

3412

3413 DB(Count). Header = DB(QRDBIndex). Header

3414 DB(Count). Header. RowCount = 0

3415 DB(Count). Cols = DB(QRDBIndex). Cols

3416

3417 MainForm. TabStrip. Tabs. Add pvCaption: ="Вывод " + Mode + str, pvImage: =1

3418 Else

3419 Count = tableindex

3420 End If

3421

3422 Dim NeedAdd As Boolean

3423 With DB(Count)

3424 Dim Rval

3425 For R% = 0 To DB(QRDBIndex). Header. RowCount - 1

3426 If (Not GlobEqual) Then

3427 Select Case Mode

3428 Case sEqual

3429 NeedAdd = (Equal(whatint, R, str) = 0)

3430 Case sAbove

3431 NeedAdd = (Equal(whatint, R, str) > 0)

3432 Case sBelow

3433 NeedAdd = (Equal(whatint, R, str) < 0)

3434 Case sCountEqual

3435 value$ = CStr(DB(QRDBIndex). Rows(R). Fields(whatint))

3436 NeedAdd = ((CStr(CalcCount(QRDBIndex, whatint, value)) = str) And (EarlierDontFind(QRDBIndex, whatint, R, value)))

3437 Case sCountAbove

3438 value$ = CStr(DB(QRDBIndex). Rows(R). Fields(whatint))

3439 NeedAdd = ((CStr(CalcCount(QRDBIndex, whatint, value)) > str) And (EarlierDontFind(QRDBIndex, whatint, R, value)))

3440 Case sCountBelow

3441 value$ = CStr(DB(QRDBIndex). Rows(R). Fields(whatint))

3442 NeedAdd = ((CStr(CalcCount(QRDBIndex, whatint, value)) < str) And (EarlierDontFind(QRDBIndex, whatint, R, value)))

3443 End Select

3444 Else

3445 NeedAdd = True

3446 End If

3447 If (NeedAdd) Then

3448 ReDim tmparr(DB(QRDBIndex). Header. ColCount)

3449 tmparr = DB(QRDBIndex). Rows(R). Fields

3450 If (Not FindRow(Count, tmparr)) Then

3451 addindex% = DB(Count). Header. RowCount

3452 ReDim Preserve DB(Count). Rows(addindex)

3453 ReDim DB(Count). Rows(addindex). Fields(DB(Count). Header. ColCount - 1)

3454 DB(Count). Rows(addindex). Fields = DB(QRDBIndex). Rows(R). Fields

3455 DB(Count). Header. RowCount = DB(Count). Header. RowCount + 1

3456 Else

3457 Call MsgForm. ErrorMsg("Добавляемая запись уже существует! ")

3458 End If

3459 End If

3460 Next R

3461 End With

3462End Sub

3463

3464Sub SwapRun(what$, str$)

3465 p% = InStr(1, str, ",")

3466 If TestZero(p) Then Exit Sub

3467 index1str$ = Trim(Left(str, p - 1))

3468 index2str$ = Trim(Mid(str, p + 1))

3469

3470 If (Not IsInteger(index1str)) Then

3471 Call ErrorInQuery

3472 Exit Sub

3473 End If

3474

3475 index1% = CInt(index1str)

3476 index2% = CInt(index2str)

3477

3478 If (index1 < 0) Or (index2 < 0) Or (index1 = index2) Then

3479 Call ErrorInQuery

3480 Exit Sub

3481 End If

3482

3483 Select Case what

3484 Case sCol

3485 With DB(QRDBIndex)

3486 If (index1 >. Header. ColCount - 1) Or (index2 >. Header. ColCount - 1) Then

3487 Call ErrorInQuery

3488 Exit Sub

3489 End If

3490 ' обмен полей

3491 Dim tmpcol As TDBElemData

3492 tmpcol =. Cols(index1)

3493. Cols(index1) =. Cols(index2)

3494. Cols(index2) = tmpcol

3495 ' обмен полей записей

3496 Dim tmpcell As Variant

3497 For R% = 0 To. Header. RowCount - 1

3498 tmpcell =. Rows(R). Fields(index1)

3499. Rows(R). Fields(index1) =. Rows(R). Fields(index2)

3500. Rows(R). Fields(index2) = tmpcell

3501 Next R

3502

3503 End With

3504 Case sRow

3505 With DB(QRDBIndex)

3506 If (index1 >. Header. RowCount - 1) Or (index2 >. Header. RowCount - 1) Then

3507 Call ErrorInQuery

3508 Exit Sub

3509 End If

3510 Dim tmprow As TDBElem

3511 tmprow =. Rows(index1)

3512. Rows(index1) =. Rows(index2)

3513. Rows(index2) = tmprow

3514 End With

3515 End Select

3516End Sub

3517

3518Sub ChangeRun(what$, param$)

3519 Select Case what

3520 Case sType ' **************...::: Type:::... ***************

3521 If Not IsInteger(param) Then

3522 Call ErrorInQuery

3523 Exit Sub

3524 End If

3525 colindex% = CLng(param)

3526 If (colindex < 0) Or (colindex > DB(QRDBIndex). Header. ColCount - 1) Then

3527 Call ErrorInQuery

3528 Exit Sub

3529 End If

3530 If (DB(QRDBIndex). Cols(colindex). Class = ccString) Then

3531 If (MsgForm. QuestMsg("Поле строкового типа преобразуется в числовой тип. " + _

3532 "Все нечисловые значения будут преобразованы в 0. " + _

3533 "Продолжить? ") <> resOk) Then Exit Sub

3534

3535 End If

3536 For i% = 0 To (DB(QRDBIndex). Header. RowCount - 1)

3537 Select Case DB(QRDBIndex). Cols(colindex). Class

3538 Case ccInteger

3539 DB(QRDBIndex). Rows(i). Fields(colindex) = CStr(DB(QRDBIndex). Rows(i). Fields(colindex))

3540 Case ccString

3541 If Not IsInteger(DB(QRDBIndex). Rows(i). Fields(colindex)) Then

3542 DB(QRDBIndex). Rows(i). Fields(colindex) = 0

3543 Else

3544 DB(QRDBIndex). Rows(i). Fields(colindex) = CLng(DB(QRDBIndex). Rows(i). Fields(colindex))

3545 End If

3546 End Select

3547 Next i

3548 Select Case DB(QRDBIndex). Cols(colindex). Class

3549 Case ccInteger

3550 DB(QRDBIndex). Cols(colindex). Class = ccString

3551 Case ccString

3552 DB(QRDBIndex). Cols(colindex). Class = ccInteger

3553 End Select

3554

3555 Case sName ' **************...::: Name:::... ***************

3556 p% = InStr(1, param, ",")

3557 If TestZero(p) Then Exit Sub

3558 colindexstr$ = Trim(Left(param, p - 1))

3559 If Not IsInteger(colindexstr) Then

3560 Call ErrorInQuery

3561 Exit Sub

3562 End If

3563 colindex% = CLng(colindexstr)

3564 param = Trim(Mid(param, p + 1))

3565 If (param = "") Then

3566 Call ErrorInQuery

3567 Exit Sub

3568 End If

3569 ' поиск на дубликат

3570 For i% = 0 To DB(QRDBIndex). Header. ColCount - 1

3571 If (DB(QRDBIndex). Cols(i). title = param) And (i <> colindex) Then

3572 Call MsgForm. ErrorMsg("Поле с названием " + param + " уже существует! ")

3573 Exit Sub

3574 End If

3575 Next i

3576 DB(QRDBIndex). Cols(colindex). title = param

3577 DB(QRDBIndex). Cols(colindex). TitleLen = Len(param)

3578 Case Default ' **************!! ***************

3579 Call ErrorInQuery

3580 End Select

3581End Sub

3582

3583Public Sub RunQuery(DBIndex_%, query$)

3584 Dim s1$, p%

3585

3586 s1 = Mid(query, 4)

3587 query = Left(query, 3)

3588

3589 QRDBIndex = DBIndex_

3590

3591 Select Case query

3592 Case sAdd

3593 query = Left(s1, 3)

3594 s1 = Mid(s1, InStr(1, s1, "("))

3595 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or ((Len(s1) < 8) And (query = sCol)) Then

3596 Call ErrorInQuery

3597 Else

3598 Call AddRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

3599 End If

3600 Case sDel

3601 query = Left(s1, 3)

3602 s1 = Mid(s1, InStr(1, s1, "("))

3603 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 5) Then

3604 Call ErrorInQuery

3605 Else

3606 Call DelRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

3607 End If

3608 Case sSort

3609 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 5) Then

3610 Call ErrorInQuery

3611 Else

3612 Call SortRun(Trim(Mid(s1, 2, Len(s1) - 2)))

3613 End If

3614 Case sOut

3615 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or (Len(s1) < 5) Then

3616 Call ErrorInQuery

3617 Else

3618 Call OutRun(Trim(Mid(s1, 2, Len(s1) - 2)))

3619 End If

3620 Case sSwap

3621 query = Left(s1, 3)

3622 s1 = Mid(s1, InStr(1, s1, "("))

3623 If (Left(s1, 1) <> "(") Or (Right(s1, 1) <> ")") Or ((Len(s1) < 5) And (query = sCol)) Then

3624 Call ErrorInQuery

3625 Else

3626 Call SwapRun(query, Trim(Mid(s1, 2, Len(s1) - 2)))

Страницы: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20