С наступающим Новым годом! Форум программистов, компьютерный форум, киберфорум
Наши страницы
VBScript/JScript/WSH/WMI/HTA
Войти
Регистрация
Восстановить пароль
 
pogrammer
4 / 4 / 1
Регистрация: 28.06.2018
Сообщений: 23
Завершенные тесты: 1
1

Редактирование баз в ibases.v8i

13.09.2018, 16:19. Просмотров 150. Ответов 2

Всем привет!

Нужна помощь со скриптом который будет дописывать (с проверкой существования) базы 1С в файлик ibases.v8i
Файл находится по пути - "%appdata%\1C\1CEStart"
Кодировка файла UTF-8
Примерная структура:

[Бухгалтерия]
Connect=Srvr="1C_serv";Ref="BUH";
ClientConnectionSpeed=Normal
App=ThinClient
WA=1
Version=8.3
[Кадры]
Connect=Srvr="1C_serv";Ref="HR";
ClientConnectionSpeed=Normal
App=ThinClient
WA=1
Version=8.3
[Кадры тест]
Connect=Srvr="1C_serv";Ref="HR_test";
ClientConnectionSpeed=Normal
App=ThinClient
WA=1
Version=8.3

Необходимо:
Ищем "Ref="BUH""
Если НЕ нашли - в конце файла с новой строки дописываем:

[Бухгалтерия тонкий]
Connect=Srvr="1C_serv";Ref="BUH";
ClientConnectionSpeed=Normal
App=ThinClient
WA=1
Version=8.3

Если нашли - продолжаем поиск до следующего символа "[" ищем "App=ThinClient"

Если НЕ нашли - в конце файла с новой строки дописываем:

[Бухгалтерия тонкий]
Connect=Srvr="1C_serv";Ref="BUH";
ClientConnectionSpeed=Normal
App=ThinClient
WA=1
Version=8.3

Если нашли и Ref="BUH" и "App=ThinClient" - поднимаемся на строчку выше и меняем наименование базы "[Бухгалтерия](тут может быть записано по разному)" - на "[Бухгалтерия Тонкий]"
0
Similar
Эксперт
41792 / 34177 / 6122
Регистрация: 12.04.2006
Сообщений: 57,940
13.09.2018, 16:19
Ответы с готовыми решениями:

Редактирование записей баз данных
<html> <head> <title>Invoices and expenses </title> </head> <body bgcolor=pink>

Редактирование записей баз данных
Найдите ошибку <html> <head> <title>Invoices and expenses </title> </head>

Подключение и редактирование баз данных ms access
Как можно подключить базу данных так, чтобы все строки определенного поля выводились в combobox...

Объединение баз данных , разделение баз.
Приветствую. Помогите разделить имеющуюся базу, и собрать все в одну. С sql только начал работать.

Запрет на ручное редактирование и разрешение на программное редактирование
Добрый день, коллеги. Вопрос следующий. Возможно ли инструментами VBA установить запрет на ручное...

2
pogrammer
4 / 4 / 1
Регистрация: 28.06.2018
Сообщений: 23
Завершенные тесты: 1
18.09.2018, 11:15  [ТС] 2
А кто может помочь отредактировать готовое решение?
http://urgor.com/articles/skript%20d...01s%208.2/view

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
Function ReadIni(myFilePath, mySection, myKey)
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8
    Const adTypeText   = 2
    const adReadLine   = -2
    const strCharSet = "UTF-8" 
 
    Dim intEqualPos
    Dim objFSO, objIniFile
    Dim strFilePath, strKey, strLeftString, strLine, strSection 
 
    Set objFSO = CreateObject( "Scripting.FileSystemObject" ) 
 
    ReadIni     = ""
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey ) 
 
    If objFSO.FileExists( strFilePath ) Then 
 
                Set objStreamFile = CreateObject("Adodb.Stream")
                objStreamFile.CharSet = strCharSet
                objStreamFile.Type = adTypeText
                objStreamFile.Open
                objStreamFile.LoadFromFile strFilePath 
 
        Do While objStreamFile.EOS = False
            strLine = Trim(objStreamFile.ReadText(adReadLine)) 
 
            ' Check if section is found in the current line
            If LCase(strLine) = "[" & LCase(strSection) & "]" Then
                strLine = Trim(objStreamFile.ReadText(adReadLine)) 
 
                ' Parse lines until the next section is reached
                Do While Left( strLine, 1 ) <> "["
                    ' Find position of equal sign in the line
                    intEqualPos = InStr( 1, strLine, "=", 1 )
                    If intEqualPos > 0 Then
                        strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                        ' Check if item is found in the current line
                        If LCase( strLeftString ) = LCase( strKey ) Then
                            ReadIni = Trim( Mid( strLine, intEqualPos + 1 ) )
                            ' In case the item exists but value is blank
                            If ReadIni = "" Then
                                ReadIni = " "
                            End If
                            ' Abort loop when item is found
                            Exit Do
                        End If
                    End If 
 
                    ' Abort if the end of the INI file is reached
                    If objIniFile.AtEndOfStream Then Exit Do 
 
                    ' Continue with next line
                    strLine = Trim( objIniFile.ReadLine )
                Loop
            Exit Do
            End If
        Loop
        objStreamFile.Close
        Set objStreamFile = Nothing
    Else
'        WScript.Echo strFilePath & " doesn't exists. Exiting..."
'        Wscript.Quit 1
    End If
End Function 
 
Sub WriteIni( myFilePath, mySection, myKey, myValue )
    Const ForReading   = 1
    Const ForWriting   = 2
    Const ForAppending = 8
        Const adTypeText   = 2
        const adReadLine   = -2
        const adWriteLine  = 1
    const adSaveCreateNotExist = 1
        const adSaveCreateOverWrite = 2
        const strCharSet   = "UTF-8" 
 
    Dim blnInSection, blnKeyExists, blnSectionExists, blnWritten
    Dim intEqualPos
    Dim objFSO, objNewIni, objOrgIni, wshShell
    Dim strFilePath, strFolderPath, strKey, strLeftString
    Dim strLine, strSection, strTempDir, strTempFile, strValue 
 
    strFilePath = Trim( myFilePath )
    strSection  = Trim( mySection )
    strKey      = Trim( myKey )
    strValue    = Trim( myValue ) 
 
    Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
    Set wshShell = CreateObject( "WScript.Shell" ) 
 
    strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
    strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName ) 
 
        Set objOrgIni = CreateObject("Adodb.Stream")
        objOrgIni.CharSet = strCharSet
        objOrgIni.Type= adTypeText
        objOrgIni.Open
        objOrgIni.LoadFromFile strFilePath 
 
        Set objNewIni = CreateObject("Adodb.Stream")
        objNewIni.CharSet = strCharSet
        objNewIni.Type= adTypeText
        objNewIni.Open 
 
    blnInSection     = False
    blnSectionExists = False
    ' Check if the specified key already exists
    blnKeyExists     = ( ReadIni( strFilePath, strSection, strKey ) <> "" )
    blnWritten       = False 
 
    ' Check if path to INI file exists, quit if not
    strFolderPath = Mid( strFilePath, 1, InStrRev( strFilePath, "\" ) )
    If Not objFSO.FolderExists ( strFolderPath ) Then
        WScript.Echo "Error: WriteIni failed, folder path (" _
                   & strFolderPath & ") to ini file " _
                   & strFilePath & " not found!"
        Set objOrgIni = Nothing
        Set objNewIni = Nothing
        Set objFSO    = Nothing
        WScript.Quit 1
    End If 
 
    While objOrgIni.EOS = False
        strLine = Trim(objOrgIni.ReadText(adReadLine))
        If blnWritten = False Then
            If LCase( strLine ) = "[" & LCase( strSection ) & "]" Then
                blnSectionExists = True
                blnInSection = True
            ElseIf InStr( strLine, "[" ) = 1 Then
                blnInSection = False
            End If
        End If 
 
        If blnInSection Then
            If blnKeyExists Then
                intEqualPos = InStr( 1, strLine, "=", vbTextCompare )
                If intEqualPos > 0 Then
                    strLeftString = Trim( Left( strLine, intEqualPos - 1 ) )
                    If LCase( strLeftString ) = LCase( strKey ) Then
                        ' Only write the key if the value isn't empty
                        ' Modification by Johan Pol
                        If strValue <> "<DELETE_THIS_VALUE>" Then
                            objNewIni.WriteText strKey & "=" & strValue, adWriteLine
                        End If
                        blnWritten   = True
                        blnInSection = False
                    End If
                End If
                If Not blnWritten Then
                    objNewIni.WriteText strLine, adWriteLine
                End If
            Else
                objNewIni.WriteLine strLine
                    ' Only write the key if the value isn't empty
                    ' Modification by Johan Pol
                    If strValue <> "<DELETE_THIS_VALUE>" Then
                        objNewIni.WriteText strKey & "=" & strValue, adWriteLine
                    End If
                blnWritten   = True
                blnInSection = False
            End If
        Else
            objNewIni.WriteText strLine, adWriteLine
        End If
    Wend 
 
    If blnSectionExists = False Then ' section doesn't exist
        objNewIni.WriteText "", adWriteLine
        objNewIni.WriteText  "[" & strSection & "]", adWriteLine
            ' Only write the key if the value isn't empty
            ' Modification by Johan Pol
            If strValue <> "<DELETE_THIS_VALUE>" Then
                objNewIni.WriteText strKey & "=" & strValue, adWriteLine
            End If
    End If 
 
    objOrgIni.Close
    objNewIni.SaveToFile strTempFile, adSaveCreateOverWrite
    objNewIni.Close 
 
    ' Delete old INI file
    objFSO.DeleteFile strFilePath, True
    ' Rename new INI file
    objFSO.MoveFile strTempFile, strFilePath 
 
    Set objOrgIni = Nothing
    Set objNewIni = Nothing
    Set objFSO    = Nothing
    Set wshShell  = Nothing
End Sub 
 
Sub deleteIni( strFilePath, mySection )
  Const ForReading   = 1
  Const ForWriting   = 2
  Const ForAppending = 8
  Const adTypeText   = 2
  const adReadLine   = -2
  const adWriteLine  = 1
  const adSaveCreateNotExist = 1
  const adSaveCreateOverWrite = 2
  const strCharSet   = "UTF-8" 
 
  Dim objFSO, objNewIni, objOrgIni, wshShell 
 
  Set objFSO   = CreateObject( "Scripting.FileSystemObject" )
  Set wshShell = CreateObject( "WScript.Shell" )
  strTempDir  = wshShell.ExpandEnvironmentStrings( "%TEMP%" )
  strTempFile = objFSO.BuildPath( strTempDir, objFSO.GetTempName ) 
 
  Set objOrgIni = CreateObject("Adodb.Stream")
  objOrgIni.CharSet = strCharSet
  objOrgIni.Type= adTypeText
  objOrgIni.Open
  objOrgIni.LoadFromFile strFilePath 
 
  Set objNewIni = CreateObject("Adodb.Stream")
  objNewIni.CharSet = strCharSet
  objNewIni.Type= adTypeText
  objNewIni.Open 
 
  Do While objOrgIni.EOS = False
    strLine = Trim(objOrgIni.ReadText(adReadLine))
    If LCase(strLine) = "[" & LCase(mySection) & "]" Then ' Есть такая секция в файле
      Do While objOrgIni.EOS = False
        strLine = Trim(objOrgIni.ReadText(adReadLine))
        If InStr(strLine, "[") = 1 then Exit Do ' Новая секция -- отваливаем
      Loop
    End If
   objNewIni.WriteText strLine, adWriteLine
  Loop 
 
  objOrgIni.Close
  objNewIni.SaveToFile strTempFile, adSaveCreateOverWrite
  objNewIni.Close 
 
  ' Delete old INI file
  objFSO.DeleteFile strFilePath, True
  ' Rename new INI file
  objFSO.MoveFile strTempFile, strFilePath 
 
  Set objOrgIni = Nothing
  Set objNewIni = Nothing
  Set objFSO    = Nothing
  Set wshShell  = Nothing
end sub 
 
Sub UpdateINI(ibase1c)
  Dim objNetwork 
  Set objNetwork = CreateObject("WScript.Network")
  DeleteIni ibase1c, "УПП"
  DeleteIni ibase1c, "ЗУП"
  if LCase(objNetwork.ComputerName) = "ts01" then
    WriteIni ibase1c, "Бухгалтерия", "Connect", "Srvr=""srv1c"";Ref=""buh82"";"
    WriteIni ibase1c, "Зарплата и Кадры", "Connect", "Srvr=""srv1c"";Ref=""zik"";"
  end if
  WriteIni ibase1c, "Производство", "Connect", "Srvr=""srv1c"";Ref=""proizv"";"
End Sub 
 
  Dim objFSO
  Dim wshShell 
 
  Set wshShell = CreateObject( "WScript.Shell" )
  Set objFSO = CreateObject("Scripting.FileSystemObject") 
 
  ' Win7
  ibase1c = wshShell.ExpandEnvironmentStrings("%USERPROFILE%")_
            +"\AppData\Roaming\1C\ibases.v8i"
  if objFSO.FileExists(ibase1c) = True Then
     UpdateINI ibase1c
  End If 
 
  ' XP
  ibase1c = wshShell.ExpandEnvironmentStrings("%USERPROFILE%")_
            +"\Application Data\1C\1CEStart\ibases.v8i"
  if objFSO.FileExists(ibase1c) = True Then
     UpdateINI ibase1c
  End If
Т.е. убрать все лишнее и добавить "вписание" нескольких строчек с проверкой, т.е. чтобы дописывалась не одна строчка как тут с проверкой, а несколько, такого формата:

[Бухгалтерия тонкий]
Connect=Srvr="1C_serv";Ref="BUH";
ClientConnectionSpeed=Normal
App=ThinClient
WA=1
Version=8.3
0
pogrammer
4 / 4 / 1
Регистрация: 28.06.2018
Сообщений: 23
Завершенные тесты: 1
20.09.2018, 09:27  [ТС] 3
Неактуально!
0
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
20.09.2018, 09:27

Объединение баз
Надо объединить 2 базы - бухгалтерскую и путевые листы. Собственно вопрос: можно ли сделать так,...

сравнение 2 баз
Всем привет) Ситуация такая: Шеф ворвался ко мне и сказал, что срочно нужно обработать 2 базы...

Использование баз
Добрый день! Относительно скоро Новый Год. Хотелось бы узнать кто как борется с набравшими...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
3
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2018, vBulletin Solutions, Inc.
Рейтинг@Mail.ru