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
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
| ' VB-Script Groupwise-Import-Aufbereitung
'
' written by Norbert Anreiter - FREEWARE!
'
' Input-File: CSV-file (1st line = headline, will be ignored!)
' all other records are treated to be User-records
' neither contacts nor group are accepted.
' Output-File: Groupwise-import-file
'
' ***** start of global declarations - for internationalization - ENGLISH VERSION is standard, even if no INI-file exists!
dontuse = "not usable" ' not usable entries from input-file (will be ignored)
example = "e.g:" ' ... for example: ...
allfiles = "All files" ' for open-message of input-file
usercancel = "Cancel by user-request" ' user requested cancel of process or IE was closed
okmsg = "Processing terminated" ' tell user End of process
separatorerror = "Seperator within this file couldn't be found!" & vbCrlf & _
"Please help me! Which seperator-sign should be used?"
' separator-value not recognized - learn from user after this message
msgdup = "erroneous parameter: duplicate use: "
' if no NAB-file is found, defaultheader will be used for GW-entries
' texts are selectable in option-field for each parameter
defaultheader = ":::TAGMAP:::0FFE0003:***,3001001E:Name,3A08001E:Office Phone Number," & _
"3A18001E:Department,3A23001E:Fax Number,3003001E:E-Mail Address," & _
"3A06001E:First Name,3A11001E:Last Name,3A17001E:Title,3A29001E:Address," & _
"3A27001E:City,3A28001E:State,3A26001E:Country,3A2A001E:ZIP Code,3002001E:E-Mail Type," & _
"3A19001E:Mailstop,3A09001E:Home Phone Number,3A1C001E:Cellular Phone Number," & _
"3A21001E:Pager Number,3A1A001E:Phone Number,600B001E:Greeting,600F001E:Owner," & _
"3A16001E:Organization,3004001E:Comments,3A00001E:User ID,6604001E:Domain," & _
"6609001E:Additional Routing,6605001E:Post Office,6603001E:GUID,6616001E:Preferred E-Mail Address," & _
"6607001E:eDirectory Distinguished Name,6608001E:Network ID,660D001E:Internet Domain," & _
"660E001E:AIM/IM Screen Name,3A45001E:Prefix,3A44001E:Middle Name," & _
"3A05001E:Generation,3A5D001E:Home Address,3A59001E:Home City,3A5C001E:Home State," & _
"3A5B001E:Home ZIP,3A5A001E:Home Country,3A50001E:Personal Web Site,3A51001E:Office Web Site," & _
"6612001E:Resource Type,6615001E:Primary Contact Name,8000001E:additional field"
' ****** end of global declarations - no more changes required below this position ******
myscript = wscript.scriptfullname
mypath = LEFT(myscript, instrrev(myscript, "\"))
maxseq = 5 ' maximum sequence-Numbers per entry
set WS = wscript.createobject ("WScript.Shell")
set FSO = Wscript.createobject ("Scripting.FileSystemObject")
' ****** get initial values
if fso.fileexists (left(myscript, len(myscript) - 3) & "INI") then
set infile = FSO.opentextfile(left(myscript, len(myscript) - 3) & "INI") ' get INI-values
while (infile.atendofstream = false) ' default is ENGLISH
inpline = infile.readline ' which will be used
if instr(inpline, "=") > 0 then ' if no INI file present
select case lcase(trim(left(inpline, instr(inpline, "=") - 1)))
case "maxseq"
maxseq = trim(mid(inpline, instr(inpline, "=") + 1)) + 0
case "headline"
htmlheadline = trim(mid(inpline, instr(inpline, "=") + 1))
case "dontuse"
dontuse = trim(mid(inpline, instr(inpline, "=") + 1))
case "example"
example = trim(mid(inpline, instr(inpline, "=") + 1))
case "allfiles"
allfiles = trim(mid(inpline, instr(inpline, "=") + 1))
case "usercancel"
usercancel = trim(mid(inpline, instr(inpline, "=") + 1))
case "okmsg"
okmsg = trim(mid(inpline, instr(inpline, "=") + 1))
case "separatorerror"
separatorerror = trim(mid(inpline, instr(inpline, "=") + 1))
case "msgdup"
msgdup = trim(mid(inpline, instr(inpline, "=") + 1))
case "defaultheader"
defaultheader = trim(mid(inpline, instr(inpline, "=") + 1))
case "ignorenabfile"
if ucase(left(trim(mid(inpline, instr(inpline, "=") + 1)), 3)) = "YES"then
ignorenabfile = 1
end if
case else
' ignore this parameter - not important for script - maybe comment?
end select
end if
wend
end if
set folder = FSO.getfolder(WS.Specialfolders("MyDocuments"))
if ignorenabfile = 0 then
set filesinfolder = folder.files
for each item in filesinfolder
if ucase(right(item.name, 3)) = "NAB" then
filename = item.name
end if
next
end if
if filename = "" then ' no NAB-file found in directory: default-headline to be used!
headline = defaultheader
else
set infile = fso.opentextfile(WS.Specialfolders("MyDocuments") & "\" & filename)
headline = infile.readline
infile.close
set infile = nothing
end if
firstname = mid(headline, instr(headline, "3A06001E:"))
firstname = left (firstname, instr(firstname, ",") - 1)
lastname = mid(headline, instr(headline, "3A11001E:"))
lastname = left(lastname, instr(lastname, ",") - 1)
dim param
param = Split (headline, ",")
anzparams = UBound(param)
on error resume next
set callparameter = WScript.Arguments
if callparameter.Count >= 1 then
' this is my filename
dlgfilename = callparameter.Item(0)
else
err.clear
Set objDialog = CreateObject("UserAccounts.CommonDialog") ' XP upwards only
if err <> 0 then
msgbox "Sorry - cannot initialize file-open dialog. Please use ""gwimp filename"""
wscript.quit
end if
objDialog.Filter = "CSV Dateien (*.CSV)|*.csv|" & allfiles & "|*.*"
objDialog.Flags = &H800 ' file must exist!
objDialog.FilterIndex = 1 ' default: *.CSV-files
objDialog.InitialDir = ws.specialfolders("MyDocuments")
intResult = objDialog.ShowOpen
dlgfilename = objdialog.filename
If dlgfilename = "" Then ' user cancelled the Open-file-dialog
Wscript.Quit
End if
end if
set infile = fso.opentextfile(dlgfilename)
inzeile = infile.readline
if instr(inzeile, ",") > 0 then
trennzeichen = ","
elseif instr(inzeile, ";") > 0 then
trennzeichen = ";"
else
trennzeichen = inputbox (separatorerror)
end if
trennzeichen = left(trennzeichen & " ", 1)
dim inparamhead
inparamhead = Split(inzeile, trennzeichen)
maxinparam = ubound(inparamhead)
dim inparam
redim infileparam (maxinparam)
while (fillparam <= maxinparam AND infile.AtEndOfStream = false)
redim inparam (maxinparam)
inparam = Split(infile.readline, trennzeichen)
fillparam = maxinparam + 1 ' terminate
for i = lbound(infileparam) to ubound(infileparam)
if i <= ubound(inparam) and i >= lbound(inparam) then
if infileparam(i) = "" then ' no value set
fillparam = i ' continue while
end if
if inparam(i) <> "" then ' value set
infileparam(i) = inparam(i)
end if
end if
next
wend
infile.close
set infile = nothing
inparam = Split(inzeile, trennzeichen) ' re-initialize header-line
inputparams = ubound(inparam)
set oIE = WScript.CreateObject("InternetExplorer.Application")
oIE.navigate "about:blank"
oIE.visible = 1
oIE.addressbar = 1 ' 0
oIE.statusbar = 1
Do While (oIE.Busy): Loop
if FSO.fileexists (left(dlgfilename, len(dlgfilename) - 3) & "STR") then
' import already run - get old selections
set strfile = fso.opentextfile(left(dlgfilename, len(dlgfilename) - 3) & "STR")
infilestrg = strfile.readline
if err = 0 then
oldparams = split(infilestrg, ",")
end if
end if
set doc1 = oIE.document ' write the html- and VBS-code to the (open) document
doc1.writeln "<!DOCTYPE html PUBLIC ""-//W3C//DTD XHTML 1.0 Transitional//EN"" ""http://www.w3.org/TR/xhtmll/DTD/xhtmll-transitional.dtd"">"
doc1.writeln "<HTML xmlns=""http://www.w3.org/1999/xhtml""><head>"
doc1.writeln "<title>GWIMP - Groupwise Importfunktion</title></head>"
doc1.writeln "<script language=""VBSCRIPT"">"
doc1.writeln "<!--" & vbCrlf & "Dim ready" & vbCrlf & "ready = ""0""" & vbCrlf & "public GWIMP_form"
doc1.writeln "Function CheckVal" & vbCrlf & " CheckVal = ready" & vbCrlf & "End Function"
doc1.writeln "Public Function getparamval (parmnr)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"getparamval = Document.header.param" & j & ".value & "":"" & " & "Document.header.param" & j & _
".options(Document.header.param" & j & ".selectedindex).text"
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Public Function setselection (parmnr, val1, val2)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"Document.header.param" & j & ".selectedindex = val1" & vbCrlf & _
"Document.header.seq" & j & ".selectindex = val2" & vbCrlf
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Public Function getval (parmnr)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"getval = Document.header.param" & j & ".selectedindex"
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Public Function getseq (parmnr)" & vbCrlf & " select case parmnr"
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln " Case " & j & vbCrlf & _
"getseq = Document.header.seq" & j & ".selectedindex"
end if
next
doc1.writeln " End Select" & vbCrlf & "End Function"
doc1.writeln "Sub Window_OnQuit ()" & vbCrlf & " ready = ""999999""" & vbCrlf & "End Sub"
doc1.writeln "Sub ResetReady" & vbCrlf & " ready = ""0""" & vbCrlf & "End Sub"
doc1.writeln "Sub OK_OnClick" & vbCrlf & " ready = ""1""" & vbCrlf & "End Sub" & vbCrlf & "'-->" & vbCrlf & "</script>"
doc1.writeln "<body bgcolor=""#FFFF99""> <FONT FACE=""Verdana""><size=11>" & vbCrlf & "<form name=""header"">" & vbCrlf
doc1.writeln "<h1><center>" & htmlheadline & "</center></h1>"
err.clear ' reset err-code to 0
on error resume next ' no more error-handling
if ubound(oldparams) < inputparams then: end if ' "ubound" failed! - set err-code to anything other than 0
if err <> 0 then ' old params are no area - not yet set (1st call)!
redim oldparams(inputparams * 2)
for i = 0 to ubound(oldparams)
oldparams(i) = -1 ' initialize default with -1-selection
next
end if
on error goto 0 ' normal error-processing
for j = 0 to inputparams
if infileparam(j) <> "" then
doc1.writeln "<b>Parameter "
if j < 10 then
doc1.writeln " "
end if
selmyval = 0
doc1.writeln j & ": </b>"
doc1.writeln "<select name=""param" & j & """>"
doc1.write "<option value=""0"""
if oldparams(j * 2) = "" then
oldparams(j * 2) = 0
else
if oldparams(j * 2) + 0 < 1 then: doc1.write " selected ": end if
end if
doc1.writeln ">" & dontuse & "</option>"
for i = 1 to anzparams
doc1.write "<option value=""" & left(param(i), instr(param(i), ":") - 1) & """"
if oldparams(j*2) + 0 = i then
if selmyval = 0 then: doc1.write " selected ": selmyval = 1: end if
elseif param(i) = inparam(j) then
if selmyval = 0 then: doc1.write " selected ": selmyval = 1: end if
end if
doc1.writeln ">" & mid(param(i), instr(param(i), ":") + 1) & "</option>"
next
doc1.writeln "</select> Pos: <select name=""seq" & j & """> & nbsp;"
selmyval = 0
for i = 1 to maxseq
doc1.write "<option value=""" & i & """"
if j > 0 and ubound (oldparams) >= j * 2 + 1then
if oldparams(j * 2 + 1) <> "" then
if oldparams(j * 2 + 1) + 1 = i then
if selmyval = 0 then: doc1.write " selected ": selmyval = 1: end if
end if
end if
end if
doc1.writeln ">" & i & "</option>"
next
doc1.write "</select> <FONT FACE=""Courier""><size=8> " & inparamhead(j)
for ii = len(trim(inparamhead(j))) to 15: doc1.write ".": next
doc1.write " " & example & left(infileparam(j), 30) & "<br /> <FONT FACE=""Verdana""><size=11>"
end if
next
doc1.writeln "<button name=""OK"" type=""button"" OnClick=""OK_OnClick"" value=""OK""> OK </button></head>"
doc1.writeln "</form></body></html>"
set docscr = oIE.Document.Script
do ' present IE-screen and get input from user
on error resume next ' don't display error when IE was closed
call oIE.Document.script.ResetReady
do
dummy = DoEvents ' do NOT lock-up machine
loop while (oIE.Document.script.CheckVal = "0" AND err = 0) ' not OK pressed, IE-screen opened
if err <> 0 then ' IE closed by user?
wscript.quit ' no input available - end routine!
end if
if oIE.Document.script.Checkval = "0" then ' OK not pressed!
msgbox (usercancel)
wscript.quit ' should not occur
end if
on error goto 0
msg = ""
buffertest = ""
for j = 0 to inputparams ' test input-parameters for duplicates
if instr(buffertest, "*" & oie.document.script.getval(j) & "," & oie.document.script.getseq(j)) > 0 _
AND oie.document.script.getval(j) > 0 then ' valid selection? != dontuse!
msg = msg & msgdup & oie.document.script.getparamval(j) & vbCrlf ' duplicate found! = error!
else
buffertest = buffertest & "*" & oie.document.script.getval(j) & "," & oie.document.script.getseq(j)
end if
next
if msg <> "" then ' duplicate entries found!
msgbox (msg) ' show message to user
end if
loop while (msg <> "") ' messages occred, so continue with loop
buffertest = "" ' clear test-buffer
ausparams = split(defaultheader, ",")
defaultheader = ""
maxparams = ubound(ausparams) + 0
redim sequout (maxparams, maxseq)
for i = 1 to maxparams: for j = 1 to maxseq: sequout(i,j) = "": next: next
bufferselfile = ""
on error resume next
for j = 0 to inputparams ' get input-parameters for output
err.reset
bufferselfile = bufferselfile & oie.document.script.getval(j) & "," & oie.document.script.getseq(j) & ","
if oie.document.script.getval(j) > 0 then
selseq = oie.document.script.getseq(j) + 1
selval = oie.document.script.getval(j) + 0
if selval > 0 then: sequout (selval, selseq) = j: end if
end if
next
on error goto 0
ausheader = ausparams(0) & "," & ausparams(1)
for j = 2 to maxparams
if sequout (j, 1) <> "" then
ausheader = ausheader & "," & ausparams(j)
end if
next
redim ausparams (ubound(inparam))
redim namedef (2)
if sequout(1, 1) = "" then ' no value for (Display)-"Name" found
sequout(1, 1) = sequout(7, 1) ' default to: lastname and
sequout(1, 2) = sequout(6, 1) ' firstname
end if
set outfile = fso.createtextfile(left(dlgfilename, len(dlgfilename) - 3) & "NAB", true)
set infile1 = fso.opentextfile(dlgfilename)
inzeile1 = infile1.readline ' ignore 1st line (should be header-line) from CSV-file
inparam = Split(inzeile, trennzeichen)
outfile.writeline ausheader ' write header-line to NAB-file
ausheader = ""
on error goto 0
while (infile1.AtEndOfStream = false)
redim inparam (Ubound(ausparams))
inparam = Split(infile1.readline, trennzeichen)
auszeile = """U"","
for j = 1 to maxparams ' inputparams
if sequout(j, 1) <> "" then
if inparam(sequout(j, 1)) <> "" then
auszeile = auszeile & """"
for k = 1 to maxseq
if sequout(j, k) <> "" then
if k > 1 AND k < maxseq AND trim(inparam(sequout(j, k))) <> "" then
auszeile = auszeile & " "
end if
auszeile = auszeile & trim(inparam(sequout(j, k)))
end if
next
auszeile = auszeile & """"
end if
auszeile = auszeile & ","
end if
next
if right (auszeile, 1) = "," then: auszeile = left(auszeile, len(auszeile) - 1): end if
outfile.writeline (auszeile) ' write data to NAB-file
wend
infile1.close
set infile1 = nothing
outfile.close
set outfile = nothing
set outfile = fso.createtextfile(left(dlgfilename, len(dlgfilename) - 3) & "STR", true)
outfile.writeline (bufferselfile) ' write selections to STR-file (for re-use)
outfile.close
set outfile = nothing
oIE.Quit ' destroy internet-exploder-window
set oIE= Nothing
msgbox okmsg ' show user message that the routine terminated |
