|
|
|
Как бороться с тормозами
|
|||
|---|---|---|---|
|
#18+
2 Сенин Виктор Согласен. Импорт незаменим ... |
|||
|
:
Нравится:
Не нравится:
|
|||
| 15.05.2003, 11:22 |
|
||
|
Как бороться с тормозами
|
|||
|---|---|---|---|
|
#18+
2 Лоху Мы в Россее (если ты здесь) всегда импорт любили ... |
|||
|
:
Нравится:
Не нравится:
|
|||
| 15.05.2003, 11:26 |
|
||
|
Как бороться с тормозами
|
|||
|---|---|---|---|
|
#18+
При редактировании модулей БД разбухает. Не помню, где нашел код для перезаписи модулей, но пользуюсь периодически уже года три. После прогона БД и ее последующего сжатия размер уменьшается процентов на 25-30. Глюков не наблюдается. Те, кто опасаются, могут попробовать сначала на копии БД. ClearModules 'имя модуля. 'Можно изменить, но тогда надо поменять и значение Const MyModuleName Option Compare Text Option Explicit Public Function ClearMdl() Dim MN As String, I As Integer, j As Integer, n As Integer Dim mdl As Module, k As Long, S As String Dim PathTempFile As String, ContainerName As String Dim NN(10000) As String Dim q As QueryDef, m As Long 'Эти константы можно изменять 'имя модуля с этой программой Const MyModuleName As String = "ClearModules" 'имя временного запроса Const QueryTempName As String = "_$Temp" 'имя временного файла Const FileTempName As String = "~Module.txt" 'Будем размещать временный файл для перекачки модулей и 'запросов в своем каталоге S = CurrentDb.Name PathTempFile = left(S, Len(S) - Len(Dir(S))) + FileTempName 'Основной цикл по видам контейнеров For I = 1 To 4 Select Case I Case 1 ContainerName = "Forms" Case 2 ContainerName = "Reports" Case 3 ContainerName = "Modules" Case 4 ContainerName = "QueryDefs" End Select SysCmd acSysCmdSetStatus, ContainerName If I < 4 Then n = CurrentDb.Containers(ContainerName).Documents.count - 1 For j = 0 To n NN(j) = CurrentDb.Containers(ContainerName).Documents(j).Name Next j Else n = CurrentDb.QueryDefs.count - 1 k = 0 For j = 0 To n S = CurrentDb.QueryDefs(j).Name If left(S, 1) <> "~" Then NN(k) = S k = k + 1 End If Next j n = k - 1 End If If n >= 0 Then SysCmd acSysCmdInitMeter, ContainerName, (n + 1) For j = 0 To n MN = NN(j) Select Case I Case 1 DoCmd.OpenForm MN, acDesign, , , , acHidden If Not Forms(MN).HasModule Then GoTo Nextj Set mdl = Forms(MN).Module Case 2 DoCmd.OpenReport MN, acDesign If Not Reports(MN).HasModule Then GoTo Nextj Set mdl = Reports(MN).Module Case 3 If MN = MyModuleName Then GoTo Nextj DoCmd.OpenModule MN Set mdl = Modules(MN) End Select If Dir(PathTempFile) <> "" Then Kill PathTempFile Open PathTempFile For Binary Access Write As #1 If I < 4 Then For k = 1 To mdl.CountOfLines S = mdl.Lines(k, 1) & Chr(13) m = m + Len(S) Put #1, , S Next k Else On Error Resume Next DoCmd.DeleteObject acQuery, QueryTempName DoCmd.Rename QueryTempName, acQuery, MN Set q = CurrentDb.QueryDefs(QueryTempName) S = q.SQL m = m + Len(S) Put #1, , S End If Close #1 Select Case I Case 1 Forms(MN).HasModule = False DoCmd.Save acForm, MN Forms(MN).HasModule = True Set mdl = Forms(MN).Module Case 2 Reports(MN).HasModule = False DoCmd.Save acReport, MN Reports(MN).HasModule = True Set mdl = Reports(MN).Module Case 3 If mdl.Type Then DoCmd.RunCommand acCmdNewObjectClassModule Else DoCmd.RunCommand acCmdNewObjectModule End If S = Modules(Modules.count - 1).Name DoCmd.Close acModule, MN DoCmd.DeleteObject acModule, MN DoCmd.Save acModule, S DoCmd.Close acModule, S DoCmd.Rename MN, acModule, S DoCmd.OpenModule MN Set mdl = Modules(MN) End Select If I < 4 Then mdl.DeleteLines 1, mdl.CountOfLines mdl.AddFromFile PathTempFile Else Open PathTempFile For Binary Access Read As #1 S = String(LOF(1), " ") Get #1, , S Close #1 On Error Resume Next Err.Clear Set q = CurrentDb.CreateQueryDef(MN, S) If Err <> 0 Then MsgBox "Ошибка в запросе " + MN + vbCrLf + "№ ошибки: " & Err & vbCrLf & Err.Description, vbInformation DoCmd.Rename MN, acQuery, QueryTempName End If On Error GoTo 0 End If Nextj: Select Case I Case 1: DoCmd.Close acForm, MN, acSaveYes Case 2: DoCmd.Close acReport, MN, acSaveYes Case 3: If MN <> MyModuleName Then DoCmd.Close acModule, MN, acSaveYes End Select SysCmd acSysCmdUpdateMeter, (j + 1) Next j Next I On Error Resume Next DoCmd.DeleteObject acQuery, QueryTempName Kill PathTempFile SysCmd acSysCmdClearStatus MsgBox "Конец работы." + vbCrLf + " Переписано " & Format(m, "# ### ### ### ##0") & " байт.", vbInformation End Function Кому надо пользуйтесь ... |
|||
|
:
Нравится:
Не нравится:
|
|||
| 15.05.2003, 15:24 |
|
||
|
Как бороться с тормозами
|
|||
|---|---|---|---|
|
#18+
Чем это лучше импорта всех объектов в новую базу? ... |
|||
|
:
Нравится:
Не нравится:
|
|||
| 15.05.2003, 15:25 |
|
||
|
Как бороться с тормозами
|
|||
|---|---|---|---|
|
#18+
A vot i link na ClearModules http://www.hiprog.com/access/article.asp?id=321 ... |
|||
|
:
Нравится:
Не нравится:
|
|||
| 15.05.2003, 15:37 |
|
||
|
Как бороться с тормозами
|
|||
|---|---|---|---|
|
#18+
2 ALL иногда предлагают mde делать. a c 2000 существует возможность сжатия автоматом при закрытии базы - и голову ломать не надо почти всегда сжата ( на момент открытия) ... |
|||
|
:
Нравится:
Не нравится:
|
|||
| 17.05.2003, 21:38 |
|
||
|
|

start [/forum/topic.php?fid=45&msg=32162428&tid=1681499]: |
0ms |
get settings: |
9ms |
get forum list: |
17ms |
check forum access: |
3ms |
check topic access: |
3ms |
track hit: |
51ms |
get topic data: |
9ms |
get forum data: |
3ms |
get page messages: |
54ms |
get tp. blocked users: |
1ms |
| others: | 208ms |
| total: | 358ms |

| 0 / 0 |
