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

2324 Exit Sub

2325 End If

2326

2327 If conf Then

2328 If (MsgForm. QuestMsg("Удалить столбец? ") <> resOk) Then Exit Sub

2329 End If

2330 ' вырезаю из полей

2331 For i% = Index To (. ColCount - 2)

2332 DB(DBIndex). Cols(i) = DB(DBIndex). Cols(i + 1)

2333 Next i

2334 ' вырезаю из записей

2335 For R% = 0 To (. RowCount - 1)

2336 For c% = Index To (. ColCount - 2)

2337 DB(DBIndex). Rows(R). Fields(c) = DB(DBIndex). Rows(R). Fields(c + 1)

2338 Next c

2339 Next R

2340

2341. ColCount =. ColCount - 1

2342 ReDim Preserve DB(DBIndex). Cols(. ColCount)

2343 DBChanged = True

2344End With

2345End Sub

2346

2347' удаление записи

2348Public Sub DelRow_(DBIndex%, Optional ByVal Index% = - 1, Optional ByVal conf As Boolean = True)

2349 With DB(DBIndex). Header

2350 If (. RowCount = 0) Then Exit Sub

2351 If (Index = - 1) Then Index =. RowCount - 1

2352 If (Index >. RowCount - 1) Then

2353 Call MsgForm. ErrorMsg("Ошибка удаления записи! ")

2354 Exit Sub

2355 End If

2356

2357 If conf Then

2358 If (MsgForm. QuestMsg("Удалить запись? ") = resNo) Then Exit Sub

2359 End If

2360 For i% = Index To (. RowCount - 2)

2361 DB(DBIndex). Rows(i) = DB(DBIndex). Rows(i + 1)

2362 Next i

2363. RowCount =. RowCount - 1

2364 ReDim Preserve DB(DBIndex). Rows(. RowCount)

2365 DBChanged = True

2366End With

2367End Sub

2368

2369Public Sub TestDBChanged()

2370 If DBChanged Then

2371 MainForm. SB. Panels(1). Picture = MainForm. ImageList1. ListImages(2). Picture

2372 Else

2373 Set MainForm. SB. Panels(1). Picture = Nothing

2374 End If

2375End Sub

2376

2377' отображение таблицы

2378Public Sub ShowTable(DBIndex%)

2379 MainForm. ListView. ListItems. Clear

2380 MainForm. ListView. ColumnHeaders. Clear

2381 If (DBIndex = - 1) Then

2382 DBPath = ""

2383 MainForm. SB. Panels(3). Text = ""

2384 GoTo exit_

2385 End If

2386 If (DB(DBIndex). Header. ColCount = 0) Then GoTo exit_

2387 For c% = 0 To DB(DBIndex). Header. ColCount - 1

2388 Call MainForm. ListView. ColumnHeaders. Add(_

2389 MainForm. ListView. ColumnHeaders. Count + 1, _

2390 "col_key_" + CStr(c), _

2391 DB(DBIndex). Cols(c). title, _

2392 1440, _

2393 lvwColumnLeft, _

2394 0 _

2395)

2396

2397 Next c

2398 For R% = 0 To DB(DBIndex). Header. RowCount - 1

2399 With MainForm. ListView. ListItems. Add

2400. Key = "row_key_" + CStr(R)

2401. Text = DB(DBIndex). Rows(R). Fields(0)

2402 For i% = 1 To DB(DBIndex). Header. ColCount - 1

2403. SubItems(i) = DB(DBIndex). Rows(R). Fields(i)

2404 Next i

2405 End With

2406 Next R

2407exit_:

2408 MainForm. TabStrip. Visible = (DBPath <> "")

2409 MainForm. ListView. Visible = MainForm. TabStrip. Visible

2410 If (DBIndex <> - 1) Then

2411 MainForm. SB. Panels(2). Text = CStr(DB(DBIndex). Header. RowCount)

2412 Else

2413 MainForm. SB. Panels(2). Text = ""

2414 End If

2415 Call TestDBChanged

2416End Sub

2417

2418' поиск поля *************************************************

2419Public Function ItColAlreadyCreate(QRDBIndex%, title$) As Boolean

2420 With DB(QRDBIndex)

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

2422 If (. Cols(i). title = title) Then

2423 ItColAlreadyCreate = True

2424 Exit Function

2425 End If

2426 Next i

2427 End With

2428 ItColAlreadyCreate = False

2429End Function

2430

2431' добавление поля *************************************************

2432Public Sub AddCol(DBIndex%, ByVal Class%, ByVal title$, ByVal defval, Optional ByVal pos% = - 1)

2433 With DB(DBIndex). Header

2434 ReDim Preserve DB(DBIndex). Cols(. ColCount)

2435 If (pos = - 1) Then

2436 pos =. ColCount

2437 Else

2438 For i% = 1 To (. ColCount - pos)

2439 DB(DBIndex). Cols(. ColCount - i + 1) = DB(DBIndex). Cols(. ColCount - i)

2440 Next i

2441 End If

2442 With DB(DBIndex). Cols(pos)

2443. Class = Class

2444. title = title

2445. TitleLen = Len(title)

2446. DefValue = defval

2447 End With

2448

2449 ' увеличиваю размерность записей

2450 For R% = 0 To DB(DBIndex). Header. RowCount - 1

2451 ReDim Preserve DB(DBIndex). Rows(R). Fields(. ColCount)

2452 For i% = 1 To (. ColCount - pos)

2453 DB(DBIndex). Rows(R). Fields(. ColCount - i + 1) = DB(DBIndex). Rows(R). Fields(. ColCount - i)

2454 Next i

2455 DB(DBIndex). Rows(R). Fields(pos) = DB(DBIndex). Cols(pos). DefValue

2456 Next R

2457

2458. ColCount =. ColCount + 1

2459

2460 DBChanged = True

2461 End With

2462End Sub

2463

2464' добавление записи *************************************************

2465Public Sub AddField(DBIndex%, row)

2466 With DB(DBIndex). Header

2467 ReDim Preserve DB(DBIndex). Rows(. RowCount)

2468 DB(DBIndex). Rows(. RowCount). Fields = row

2469. RowCount =. RowCount + 1

2470 DBChanged = True

2471 End With

2472End Sub

2473

2474' удаление таблицы *************************************************

2475Public Sub DelTable(Index%)

2476 For i% = Index To (UBound(DB) - 1)

2477 DB(i) = DB(i + 1)

2478 Next i

2479 If (UBound(DB) > 0) Then ReDim Preserve DB(UBound(DB) - 1)

2480End Sub

2481

2482' если нужно то строка шифруется по паролю, иначе не изменяется

2483Function CodeDecode(Index%, str$, col%, row%, Optional pass$ = "", Optional usepass As Boolean = False) As String

2484 If Not usepass Then pass$ = DB(Index). Password

2485 If (pass = "") Then

2486 CodeDecode = str

2487 Exit Function

2488 End If

2489 CodeDecode = ""

2490 p% = 1

2491 Dim ch As Byte

2492 For i% = 1 To Len(str)

2493 ch = Asc(Mid(str, i, 1)) Xor Asc(Mid(pass, p, 1)) Xor col Xor row

2494 CodeDecode = CodeDecode + Chr(ch)

2495 p = p + 1: If p > Len(pass) Then p = 1

2496 Next i

2497End Function

2498

2499' сохранение БД в файле *************************************************

2500Public Sub FlushDB(DBIndex%)

2501 Dim s$, W%

2502 If Not UserIsAdmin Then

2503 Call ProtectedMsg

2504 Exit Sub

2505 End If

2506 If (DBPath <> "") Then

2507 Call DeleteFile(DBPath)

2508 DBI% = FreeFile

2509 Open DBPath For Binary As DBI

2510

2511 ' заголовок - 12

2512 Put DBI,, DB(DBIndex). Header

2513

2514 ' если надо, то сохраняю пароль

2515 If (DB(DBIndex). Header. Flags And flPasswordNeed) Then

2516 Dim str$, ch1 As Byte, ch2 As Byte

2517 Dim lng As Byte, lng2 As Byte

2518 lng = Len(DB(DBIndex). Password)

2519 lng2 = lng / 2

2520 Put DBI,, lng

2521

2522 For i% = 1 To lng2

2523 ch1 = Asc(Mid(DB(DBIndex). Password, i, 1))

2524 ch2 = Asc(Mid(DB(DBIndex). Password, lng - i + 1, 1))

2525 str = Chr(ch1 Xor ch2) + str

2526 Next i

2527 For i = lng2 To 1 Step - 1

2528 Put DBI,, CByte(Asc(Mid(str, i, 1)))

2529 Next i

2530 End If ' сохранение пароля

2531

2532 ' данные полей

2533 Dim l As Long

2534 For i% = 0 To DB(DBIndex). Header. ColCount - 1

2535 Put DBI,, DB(DBIndex). Cols(i). Class

2536 Put DBI,, DB(DBIndex). Cols(i). TitleLen

2537 If (DB(Index). Header. Flags And flCoded) Then

2538 Put DBI,, CodeDecode(DBIndex, DB(DBIndex). Cols(i). title, i, 0)

2539 Else

2540 Put DBI,, DB(DBIndex). Cols(i). title

2541 End If

2542 Select Case DB(DBIndex). Cols(i). Class

2543 Case ccString

2544 If (DB(Index). Header. Flags And flCoded) Then

2545 s = CodeDecode(DBIndex, CStr(DB(DBIndex). Cols(i). DefValue), i, 0)

2546 Else

2547 s = CStr(DB(DBIndex). Cols(i). DefValue)

2548 End If

2549 W = Len(s)

2550 Put DBI,, W

2551 Put DBI,, s

2552 Case ccInteger

2553 l = CInt(DB(DBIndex). Cols(i). DefValue)

2554 Put DBI,, l

2555 End Select

2556 Next i

2557

2558 ' запись контрольного байта

2559 Put DBI,, ValidateByte

2560

2561 ' записи

2562 Dim f As TDBElem

2563 Dim col As TDBElemData

2564 For R% = 0 To DB(DBIndex). Header. RowCount - 1

2565 f = DB(DBIndex). Rows(R)

2566 For c% = 0 To DB(DBIndex). Header. ColCount - 1

2567 col = DB(DBIndex). Cols(c)

2568 ' в зависимости от типа данных колонки пишу в файл определённый тип данных

2569 Select Case col. Class

2570 ' если число - записываю как long

2571 Case ccInteger

2572 l = CLng(f. Fields(c))

2573 Put DBI,, l

2574 ' если строка - то байт длины и сама строка

2575 Case ccString

2576 If (DB(Index). Header. Flags And flCoded) Then

2577 s = CodeDecode(DBIndex, CStr(f. Fields(c)), c, R)

2578 Else

2579 s = CStr(f. Fields(c))

2580 End If

2581 ' Len возвращает 4 байта, а мне нужно 2

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