Page 1 of 1 1
Topic Options
#182980 - 2007-11-28 01:50 PM n00b question... convert from vbs to kix... (again)
Hotzenwalder Offline
Fresh Scripter

Registered: 2006-01-26
Posts: 26
I need this script translated into kixcode. Some parts I understand, but most parts are total abracadabra to me. Could someone guide me? If not I would have to write a kixscript around it that shells to different vbscript files for different Outlook signatures. \:\( I've searched throught the forums, but the only usable solutions seems to have someone translate if for me.

 Code:
'====================
'
' VBScript: <Signatures.vbs>
' AUTHOR: Peter Aarts
' Contact Info: peter.aarts@l1.nl
' Version 2.04
' Date: January 20, 2006
'
'====================

'Option Explicit
On Error Resume Next

Dim qQuery, objSysInfo, objuser
Dim FullName, EMail, Title, PhoneNumber, MobileNumber, FaxNumber, OfficeLocation, Department
Dim web_address, FolderLocation, HTMFileString, StreetAddress, Town, State, Company
Dim ZipCode, PostOfficeBox, UserDataPath

' Read LDAP(Active Directory) information to asigns the user's info to variables.
'====================
Set objSysInfo = CreateObject("ADSystemInfo")
objSysInfo.RefreshSchemaCache
qQuery = "LDAP://" & objSysInfo.Username
Set objuser = GetObject(qQuery)

FullName = objuser.displayname
EMail = objuser.mail
Company = objuser.Company
Title = objuser.title
PhoneNumber = objuser.TelephoneNumber
FaxNumber = objuser.FaxNumber
OfficeLocation = objuser.physicalDeliveryOfficeName
StreetAddress = objuser.streetaddress
PostofficeBox = objuser.postofficebox
Department = objUser.Department
ZipCode = objuser.postalcode
Town = objuser.l
MobileNumber = objuser.TelephoneMobile
web_address = "http://www.l1.nl"

' This section creates the signature files names and locations.
'====================
' Corrects Outlook signature folder location. Just to make sure that
' Outlook is using the purposed folder defined with variable : FolderLocation
' Example is based on Dutch version.
' Changing this in a production enviremont might create extra work
' all employees are missing their old signatures
'====================
Dim objShell, RegKey, RegKeyParm
Set objShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
RegKey = RegKey & "\Signatures"
objShell.RegWrite RegKey , "Handtekeningen"
UserDataPath = ObjShell.ExpandEnvironmentStrings("%appdata%")
FolderLocation = UserDataPath &"\Microsoft\Handtekeningen\"
HTMFileString = FolderLocation & "prc-new.htm"

' This section checks if the signature directory exits and if not creates one.
'====================
Dim objFS1
Set objFS1 = CreateObject("Scripting.FileSystemObject")
If (objFS1.FolderExists(FolderLocation)) Then
Else
Call objFS1.CreateFolder(FolderLocation)
End if

' The next section builds the signature file
'====================
Dim objFSO
Dim objFile,afile
Dim aQuote
aQuote = chr(34)

' This section builds the HTML file version
'====================
Set objFSO = CreateObject("Scripting.FileSystemObject")

' This section deletes to other signatures.
' These signatures are automaticly created by Outlook 2003.
'====================
Set AFile = objFSO.GetFile(Folderlocation&"prc-new.rtf")
aFile.Delete
Set AFile = objFSO.GetFile(Folderlocation&"prc-new.txt")
aFile.Delete

Set objFile = objFSO.CreateTextFile(HTMFileString,True)
objFile.Close
Set objFile = objFSO.OpenTextFile(HTMFileString, 2)

objfile.write "<!DOCTYPE HTML PUBLIC " & aQuote & "-//W3C//DTD HTML 4.0 Transitional//EN" & aQuote & ">" _
 & vbCrLf
objfile.write "<HTML><HEAD><TITLE>Microsoft Office Outlook Signature</TITLE>" _
& vbCrLf
objfile.write "<META http-equiv=Content-Type content=" & aQuote & "text/html; charset=windows-1252" & aQuote & ">" _
& vbCrLf
objfile.write "<META content=" & aQuote & "MSHTML 6.00.3790.186" & aQuote & " name=GENERATOR></HEAD>" & vbCrLf
objfile.write "<BODY link=#FFFFFF alink=#FFCC00 vlink=#FFFFFF>" & vbCrLf
objfile.write "<FONT size=2 face=" & aQuote & "Arial" & aQuote & " color=black>Met vriendelijke groet,<br>"& vbCrLf
objfile.write "<BR>" & vbCrLf
objfile.write "<B><FONT size=2>"& FullName & "</B><BR>" & vbCrLf
objfile.write Department& " " & title & "<BR><BR>" & vbCrLf
objfile.write "<FONT size=2 face=" & aQuote & "Arial" & aQuote & " color=Navy><B>"& Company & "</B><BR>" & vbCrLf
objfile.write "<FONT size=2 color=black>" & StreetAddress&", "&PostOfficeBox&", "&ZipCode&", "&town&"<BR>"& vbCrLf
objfile.write "<B><FONT size=2 color=navy>T</B><FONT size=2 color=black> " & PhoneNumber & " | " _
& "<B><FONT size=2 color=navy>M</B><FONT size=2 color=black> " & MobileNumber & " | " & "<B><FONT size=2 color=navy>F</B><FONT size=2 color=black> " _
& FaxNumber & "<BR>" & vbCrLf
objfile.write "<B><FONT size=2 color=navy>E</B><FONT size=2 color=black> " & Email &" | " & "<B><FONT size=2 color=navy>I</B><FONT size=2 color=black> " & web_address & vbCrLf
objfile.write "</FONT></BODY></HTML>" & vbCrLf
objFile.Close

' ===========================
' This section readsout the current Outlook profile and then sets the name of the default Signature
' ===========================
' Use this version to set all accounts
' in the default mail profile
' to use a previously created signature

Call SetDefaultSignature("prc-new","")

' Use this version (and comment the other) to
' modify a named profile.
'Call SetDefaultSignature _
' ("Signature Name", "Profile Name")

Sub SetDefaultSignature(strSigName, strProfile)
Const HKEY_CURRENT_USER = &H80000001
strComputer = "."

If Not IsOutlookRunning Then
Set objreg = GetObject("winmgmts:" & _
"{impersonationLevel=impersonate}!\\" & _
strComputer & "\root\default:StdRegProv")
strKeyPath = "Software\Microsoft\Windows NT\" & _
"CurrentVersion\Windows " & _
"Messaging Subsystem\Profiles\"
' get default profile name if none specified
If strProfile = "" Then
objreg.GetStringValue HKEY_CURRENT_USER, _
strKeyPath, "DefaultProfile", strProfile
End If
' build array from signature name
myArray = StringToByteArray(strSigName, True)
strKeyPath = strKeyPath & strProfile & _
"\9375CFF0413111d3B88A00104B2A6676"
objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, _
arrProfileKeys
For Each subkey In arrProfileKeys
strsubkeypath = strKeyPath & "\" & subkey
objreg.SetBinaryValue HKEY_CURRENT_USER, _
strsubkeypath, "New Signature", myArray
objreg.SetBinaryValue HKEY_CURRENT_USER, _
strsubkeypath, "Reply-Forward Signature", myArray
Next
Else
strMsg = "Please shut down Outlook before " & _
"running this script."
MsgBox strMsg, vbExclamation, "SetDefaultSignature"
End If
End Sub

Function IsOutlookRunning()
strComputer = "."
strQuery = "Select * from Win32_Process " & _
"Where Name = 'Outlook.exe'"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If UCase(objProcess.Name) = "OUTLOOK.EXE" Then
IsOutlookRunning = True
Else
IsOutlookRunning = False
End If
Next
End Function

Public Function StringToByteArray _
(Data, NeedNullTerminator)
Dim strAll
strAll = StringToHex4(Data)
If NeedNullTerminator Then
strAll = strAll & "0000"
End If
intLen = Len(strAll) \ 2
ReDim arr(intLen - 1)
For i = 1 To Len(strAll) \ 2
arr(i - 1) = CByte _
("&H" & Mid(strAll, (2 * i) - 1, 2))
Next
StringToByteArray = arr
End Function

Public Function StringToHex4(Data)
' Input: normal text
' Output: four-character string for each character,
' e.g. "3204" for lower-case Russian B,
' "6500" for ASCII e
' Output: correct characters
' needs to reverse order of bytes from 0432
Dim strAll
For i = 1 To Len(Data)
' get the four-character hex for each character
strChar = Mid(Data, i, 1)
strTemp = Right("00" & Hex(AscW(strChar)), 4)
strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)
Next
StringToHex4 = strAll
End Function


Edited by Richard H. (2007-12-03 09:36 AM)
Edit Reason: Long lines broken up for readability

Top
#183015 - 2007-11-28 11:47 PM Re: n00b question... convert from vbs to kix... (again) [Re: Hotzenwalder]
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11564
Loc: CA
There are a couple of recent Signature script posts on the board.

Do you have a link to where you got this script from?

What specifically did you want or need changed if this can not be easily converted?

Top
#183033 - 2007-11-29 09:35 AM Re: n00b question... convert from vbs to kix... (again) [Re: NTDOC]
Hotzenwalder Offline
Fresh Scripter

Registered: 2006-01-26
Posts: 26
The recent scripts use Word as the editor of choice for generating the signature. I want to write raw html codes to a specific file. If I just get the code get some items about @USERID from the AD and put those in a specific file I would be on my way. I could ofcourse get a script that reads AD info and use writeline to output it to a file, but somehow I don't think this is the correct way to do it...

The final script should generate signature files based on active directory information and one of those signatures has to be made the default based on group membership.

Hope this helps.

Top
#183035 - 2007-11-29 12:00 PM Re: n00b question... convert from vbs to kix... (again) [Re: Hotzenwalder]
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11564
Loc: CA
Okay well I don't have time tonight to convert the whole thing but here is an example - just keep building on this with similar method.

 Code:
;'====================
;'
;' VBScript: <Signatures.vbs>
;' AUTHOR: Peter Aarts
;' Contact Info: peter.aarts@l1.nl
;' Version 2.04
;' Date: January 20, 2006
;'
;'====================

;Option Explicit

Dim $qQuery, $objSysInfo, $objuser
Dim $FullName, $EMail, $Title, $PhoneNumber, $MobileNumber, $FaxNumber, $OfficeLocation, $Department
Dim $web_address, $FolderLocation, $HTMFileString, $StreetAddress, $Town, $State, $Company
Dim $ZipCode, $PostOfficeBox, $UserDataPath

; Read LDAP(Active Directory) information to asigns the user's info to variables.
;====================
$objSysInfo = CreateObject("ADSystemInfo")
$objSysInfo.RefreshSchemaCache
$qQuery = "LDAP://" + $objSysInfo.Username
$objuser = GetObject($qQuery)

$FullName = $objuser.displayname
$EMail = $objuser.mail
$Company = $objuser.Company
$Title = $objuser.title
$PhoneNumber = $objuser.TelephoneNumber
$FaxNumber = $objuser.FaxNumber
$OfficeLocation = $objuser.physicalDeliveryOfficeName
$StreetAddress = $objuser.streetaddress
$PostofficeBox = $objuser.postofficebox
$Department = $objUser.Department
$ZipCode = $objuser.postalcode
$Town = $objuser.l
$MobileNumber = $objuser.TelephoneMobile
$web_address = "http://www.l1.nl"

; This section creates the signature files names and locations.
;====================
; Corrects Outlook signature folder location. Just to make sure that
; Outlook is using the purposed folder defined with variable : FolderLocation
; Example is based on Dutch version.
; Changing this in a production enviremont might create extra work
; all employees are missing their old signatures
;====================
Dim $objShell, $RegKey, $RegKeyParm
$objShell = CreateObject("WScript.Shell")
$RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
$RegKey = $RegKey + "\Signatures"
$objShell.RegWrite $RegKey , "Handtekeningen"
$UserDataPath = $ObjShell.ExpandEnvironmentStrings("%appdata%")
$FolderLocation = $UserDataPath +"\Microsoft\Handtekeningen\"
$HTMFileString = $FolderLocation + "prc-new.htm"

; This section checks if the signature directory exits and if not creates one.
;====================
$objFS1
$objFS1 = CreateObject("Scripting.FileSystemObject")
If ($objFS1.FolderExists($FolderLocation))
Else
Call $objFS1.CreateFolder($FolderLocation)
Endif

; The next section builds the signature file
;====================
Dim $objFSO
Dim $objFile, $afile
Dim $aQuote
$aQuote = chr(34)

; This section builds the HTML file version
;====================
$objFSO = CreateObject("Scripting.FileSystemObject")

; This section deletes to other signatures.
; These signatures are automaticly created by Outlook 2003.
;====================
$AFile = $objFSO.GetFile($Folderlocation+"prc-new.rtf")
$aFile.Delete
$AFile = $objFSO.GetFile($Folderlocation+"prc-new.txt")
$aFile.Delete

$objFile = $objFSO.CreateTextFile($HTMFileString,"True")
$objFile.Close
$objFile = $objFSO.OpenTextFile($HTMFileString, 2)

Top
#183036 - 2007-11-29 12:43 PM Re: n00b question... convert from vbs to kix... (again) [Re: NTDOC]
oneill Offline
Fresh Scripter

Registered: 2005-03-24
Posts: 27
Loc: Australia
Hi,

Here is a function I wrote a couple of months back to create a signature in outlook using word, which is the correct way to do it apparently.
MS Scripting Guy

I have tested this for Office 2003/2007, should also work for Office XP but not Office 2000. If you need it for Office 2000 the let me know and i'll post the code for that.

This will create a signature and a reply.

 Code:
 
CreateOutlookSignature() 

Function CreateOutlookSignature()

$objSysInfo 	= CreateObject("ADSystemInfo")
$strUser 	= $objSysInfo.UserName
$objUser	= GetObject("LDAP://" + $strUser)
$strFullName 	= $objUser.FullName
$strSN 		= $objUser.sn
$strmobile 	= $objUser.mobile
$strTitle 	= $objUser.Title
$strDepartment  = $objUser.Department
$strCompany 	= $objUser.Company
$strPhone 	= $objUser.telephoneNumber
$strGivenName 	= $objUser.givenname
$strMail 	= $objUser.mail

$objWord 	= CreateObject("Word.Application")
$objDoc 	= $objWord.Documents.Add()
$objSelection 	= $objWord.Selection

$objSelection.TypeText("Kind Regards,")
$objSelection.TypeText(Chr(11))
$objSelection.TypeText(Chr(11))
$objSelection.TypeText($strGivenName + " " + $strSN)
$objSelection.TypeText(Chr(11))
$objSelection.TypeText($strTitle)
$objSelection.TypeText(Chr(11))
$objSelection.TypeText(Chr(11))
$objSelection.TypeText($strCompany)
$objSelection.TypeText(Chr(11))
$objSelection.TypeText("P: " + $strPhone)
$objSelection.TypeText(Chr(11))
$objSelection.TypeText("M: " + $strmobile)
$objSelection.TypeText(Chr(11))
$objSelection.TypeText($strmail)

$objSelection 	= $objDoc.Range()
$objSelection.Font.Name = "Arial"
$objSelection.Font.Size = 10


$Discard = $objWord.EmailOptions.EmailSignature.EmailSignatureEntries.Add('Signature',$objSelection)
$objWord.EmailOptions.EmailSignature.NewMessageSignature = 'CSE_Signature'

 
$objDoc.Saved = 1
$objWord.Quit

;Reply
$objWord 	= CreateObject("Word.Application")
$objDoc 	= $objWord.Documents.Add()
$objSelection 	= $objWord.Selection

$objSelection.TypeText("Kind Regards,")
$objSelection.TypeText(Chr(11))
$objSelection.TypeText(Chr(11))
$objSelection.TypeText($strGivenName + " " + $strSN)
$objSelection.TypeText(Chr(11))
$objSelection.TypeText($strTitle)

$objSelection 	        = $objDoc.Range()
$objSelection.Font.Name = "Arial"
$objSelection.Font.Size = 10

$Discard = $objWord.EmailOptions.EmailSignature.EmailSignatureEntries.Add('Reply',$objSelection)
$objWord.EmailOptions.EmailSignature.ReplyMessageSignature = 'CSE_Reply'

$objDoc.Saved = 1
$objWord.Quit

EndFunction 


Edited by oneill3 (2007-11-29 12:45 PM)

Top
#183037 - 2007-11-29 12:48 PM Re: n00b question... convert from vbs to kix... (again) [Re: oneill]
Hotzenwalder Offline
Fresh Scripter

Registered: 2006-01-26
Posts: 26
Thank you... I will give it a spin.
Top
#183069 - 2007-11-30 10:26 AM Re: n00b question... convert from vbs to kix... (again) [Re: Hotzenwalder]
Hotzenwalder Offline
Fresh Scripter

Registered: 2006-01-26
Posts: 26
The script that uses Word to generate the signature works ok, but I've ran into problems trying to paste an URL into the signature. I want the webpage link to be clickable, but I can't seem to find out how to get the html code activated in word... in raw HTML it's simple...
 Code:
<a href="www.somesite.com">Some Site</a>

Now... how will that be translated to code to be pasted to Word or is there a special command to select a bunch of text and create an HTML link with that text?

If this fails I will go back to simple writeline statements, because that way I have much more control over the HTML that is generated in the end.

Top
#183070 - 2007-11-30 10:53 AM Re: n00b question... convert from vbs to kix... (again) [Re: Hotzenwalder]
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11564
Loc: CA
Yeah, actually Microsoft Outlook does not seem to properly use modern Web Standards for HTML messages (required for active links)


Create what you want live in Outlook and then look at the code with a text editor and you'll see that it is odd.

If you manually set it up using Web Standards it seems to ignore some items.

I'd do some Google searching on Microsoft for COM and File Types maybe for MS Word.

Top
#183072 - 2007-11-30 11:38 AM Re: n00b question... convert from vbs to kix... (again) [Re: NTDOC]
Hotzenwalder Offline
Fresh Scripter

Registered: 2006-01-26
Posts: 26
[edited at 13:13 GMC+1]

Almost there... here's the code so far

 Code:
;Option Explicit

Dim $qQuery, $objSysInfo, $objuser
Dim $strTitle, $strWeb, $strGivenName, $strSN
Dim $FolderLocation, $HTMFileString, $UserDataPath

;Read LDAP(Active Directory) information to asigns the user's info to variables.
$objSysInfo 	= CreateObject("ADSystemInfo")
$qQuery 	= "LDAP://" + $objSysInfo.Username
$objuser 	= GetObject($qQuery)

$objSysInfo.RefreshSchemaCache

$strGivenName	= $objuser.givenname
$strSN		= $objuser.sn
$strTitle 	= $objuser.title
$strWeb 	= $objuser.wwwhomepage

; This section creates the signature files names and locations.
Dim $objShell, $RegKey, $RegKeyParm
$objShell 	= CreateObject("WScript.Shell")
$RegKey 	= "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
$RegKey 	= $RegKey + "\Signatures"
$objShell.RegWrite ($RegKey, "Handtekeningen")
$UserDataPath 	= $ObjShell.ExpandEnvironmentStrings("%appdata%")
$FolderLocation = $UserDataPath +"\Microsoft\Handtekeningen\"
$HTMFileString 	= $FolderLocation + "PRC NL.HTM"

; This section checks if the signature directory exits and if not creates one.
;====================
$objFS1
$objFS1 = CreateObject("Scripting.FileSystemObject")
If ($objFS1.FolderExists($FolderLocation))
Else
	Call $objFS1.CreateFolder($FolderLocation)
Endif

; The next section builds the signature file
;====================
Dim $objFSO
Dim $objFile, $afile
Dim $aQuote
$aQuote = chr(34)

; This section builds the HTML file version
;====================
$objFSO = CreateObject("Scripting.FileSystemObject")

; These signatures are automaticly created by Outlook 2003.
;====================
$AFile = $objFSO.GetFile($Folderlocation+"PRC NL.rtf")
$aFile.Delete
$AFile = $objFSO.GetFile($Folderlocation+"PRC NL.txt")
$aFile.Delete

$objFile = $objFSO.CreateTextFile($HTMFileString,"True")
$objFile.Close
$objFile = $objFSO.OpenTextFile($HTMFileString, 2)

$objfile.writeline ("<HTML><HEAD><TITLE>Microsoft Office Outlook Signature</TITLE>")
$objfile.writeline ("<META http-equiv=Content-Type content=text/html; charset=windows-1252>")
$objfile.writeline ("<META content=6.00.3790.186 name=GENERATOR></HEAD>")
$objfile.writeline ("<BODY>")
$objfile.writeline ("<font size=2 face=Arial>Met vriendelijke groet,<BR>")
$objfile.writeline ("<BR>")
$objfile.writeline ("$strGivenName $strSN <BR>")
$objfile.writeline ("$strTitle <BR><BR>")
$objfile.writeline ("PRC B.V. <BR>")
$objfile.writeline ("Postbus 1051, 2410 CB Bodegraven <BR>")
$objfile.writeline ("Goudseweg 181, 2411 HK Bodegraven <BR>")
$objfile.writeline ("Tel.: 0172 631414 <BR>")
$objfile.writeline ("KvK nr: 29 04 52 12 Leiden <BR>")
$objfile.writeline ("Internet: <a href=$strWeb>$strWeb</a><BR>")
$objfile.writeline ("<BR></FONT>")
$objfile.writeline ("<font size=1 face=Arial>")
$objfile.writeline ("--- DISCLAIMER --- <BR>")
$objfile.writeline ("De informatie verzonden met dit e-mail bericht is vertrouwelijk en uitsluitend bestemd voor de beoogde geadresseerde."
+" Indien u niet de beoogde ontvanger bent dan is gebruik, openbaarmaking, vermenigvuldiging, verspreiding en/of verstrekking aan derden verboden."
+" U wordt verzocht bij onjuiste ontvangst de afzender direct te informeren door het bericht te retourneren."
+" PRC BV, statutair gevestigd te Bodegraven en geregistreerd in het Handelsregister onder nr. 29045212,"
+" is niet aansprakelijk voor welke schade dan ook als gevolg van communicatie per e-mail en verzending van documenten en gegevens<BR><BR>")
$objfile.writeline ("<img src=logo/prc_kl.jpg><BR><BR>")
$objfile.writeline ("</FONT></BODY></HTML>")
$objFile.Close


Edited by Richard H. (2007-12-03 09:32 AM)
Edit Reason: Extremely long line broken down a bit.

Top
#183107 - 2007-11-30 08:33 PM Re: n00b question... convert from vbs to kix... (again) [Re: Hotzenwalder]
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11564
Loc: CA
Well you could use KiX to write the entry, but that aside.

I would recommend placing your data into a variable and then doing a single write.

$objfile.writeline

one time instead of over and over. That would speed up the script quite a bit.

Top
#183130 - 2007-12-01 08:42 PM Re: n00b question... convert from vbs to kix... (again) [Re: NTDOC]
Arend_ Moderator Online   sleepy
MM club member
*****

Registered: 2005-01-17
Posts: 1864
Loc: Hilversum, The Netherlands
I've translated the script for you, however you are still required to do some things yourself (have to learn a little bit). You will have to find out a different way of using VB's Hex() function, it is not supported in kixtart, the same applies to CByte(), AscW() and Mid(). I will give you a hint for Mid(), lookup SubStr() in the kixtart documents.
Also keep in mind that this signature is made for a dutch Outlook/Windows and sets Dutch registry settings and won't work on an English version.

 Code:
;====================
;
; VBScript: <Signatures.vbs>
; AUTHOR: Peter Aarts
; Contact Info: peter.aarts@l1.nl
; Version 2.04
; Date: January 20, 2006
;
;====================

;Option Explicit

Dim $objSysInfo, $objuser
Dim $FullName, $EMail, $Title, $PhoneNumber, $MobileNumber, $FaxNumber, $OfficeLocation, $Department
Dim $web_address, $FolderLocation, $HTMFileString, $StreetAddress, $Town, $Company
Dim $ZipCode, $PostOfficeBox, $UserDataPath

; Read LDAP(Active Directory) information to asigns the user's info to variables.
;====================
$objSysInfo = CreateObject("ADSystemInfo")
$objSysInfo.RefreshSchemaCache
$objuser = GetObject("LDAP://" + $objSysInfo.Username)
$FullName = $objuser.displayname
$EMail = $objuser.mail
$Company = $objuser.Company
$Title = $objuser.title
$PhoneNumber = $objuser.TelephoneNumber
$FaxNumber = $objuser.FaxNumber
$OfficeLocation = $objuser.physicalDeliveryOfficeName
$StreetAddress = $objuser.streetaddress
$PostOfficeBox = $objuser.postofficebox
$Department = $objuser.Department
$ZipCode = $objuser.postalcode
$Town = $objuser.l
$MobileNumber = $objuser.TelephoneMobile
$web_address = "http://www.l1.nl"

; This section creates the signature files names and locations.
;====================
; Corrects Outlook signature folder location. Just to make sure that
; Outlook is using the purposed folder defined with variable : $FolderLocation
; Example is based on Dutch version.
; Changing this in a production enviremont might create extra work
; all employees are missing their old signatures
;====================
Dim $objShell, $RegKey
$objShell = CreateObject("WScript.Shell")
$RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
$RegKey = $RegKey + "\Signatures"
$objShell.RegWrite($RegKey , "Handtekeningen")
$UserDataPath = $objShell.ExpandEnvironmentStrings("%appdata%")
$FolderLocation = $UserDataPath +"\Microsoft\Handtekeningen\"
$HTMFileString = $FolderLocation + "prc-new.htm"

; This section checks if the signature directory exits and if not creates one.
;====================
Dim $objFS1
$objFS1 = CreateObject("Scripting.FileSystemObject")
If NOT $objFS1.FolderExists($FolderLocation)
  $objFS1.CreateFolder($FolderLocation)
EndIf

; The next section builds the signature file
;====================
Dim $objFSO
Dim $objFile, $afile
Dim $aQuote
$aQuote = chr(34)

; This section builds the HTML file version
;====================
$objFSO = CreateObject("Scripting.FileSystemObject")

; This section deletes to other signatures.
; These signatures are automaticly created by Outlook 2003.
;====================
$afile = $objFSO.GetFile($FolderLocation+"prc-new.rtf")
$afile.Delete
$afile = $objFSO.GetFile($FolderLocation+"prc-new.txt")
$afile.Delete

$objFile = $objFSO.CreateTextFile($HTMFileString, 1)
$objFile.Close
$objFile = $objFSO.OpenTextFile($HTMFileString, 2)

$objFile.Write("<!DOCTYPE HTML PUBLIC " + $aQuote + "-//W3C//DTD HTML 4.0 Transitional//EN" + $aQuote + ">" + @CRLF)
$objFile.Write("<HTML><HEAD><TITLE>Microsoft Office Outlook Signature</TITLE>" + @CRLF)
$objFile.Write("<META http-equiv=Content-Type content=" + $aQuote + "text/html; charset=windows-1252" + $aQuote + ">" + @CRLF)
$objFile.Write("<META content=" + $aQuote + "MSHTML 6.00.3790.186" + $aQuote + " name=GENERATOR></HEAD>" + @CRLF)
$objFile.Write("<BODY link=#FFFFFF alink=#FFCC00 vlink=#FFFFFF>" + @CRLF)
$objFile.Write("<FONT size=2 face=" + $aQuote + "Arial" + $aQuote + " color=black>Met vriendelijke groet,<br>"+ @CRLF)
$objFile.Write("<BR>" + @CRLF)
$objFile.Write("<B><FONT size=2>"+ $FullName + "</B><BR>" + @CRLF)
$objFile.Write($Department + " " + $Title + "<BR><BR>" + @CRLF)
$objFile.Write("<FONT size=2 face=" + $aQuote + "Arial" + $aQuote 
+ " color=Navy><B>"+ $Company + "</B><BR>" + @CRLF)
$objFile.Write("<FONT size=2 color=black>" 
+ $StreetAddress+", "+$PostOfficeBox+", "+$ZipCode+", "+$Town+"<BR>"+ @CRLF)
$objFile.Write("<B><FONT size=2 color=navy>T</B><FONT size=2 color=black> " + $PhoneNumber + " | " + "<B><FONT size=2 color=navy>M</B><FONT size=2 color=black> " 
+ $MobileNumber + " | " + "<B><FONT size=2 color=navy>F</B><FONT size=2 color=black> " + $FaxNumber + "<BR>" + @CRLF)
$objFile.Write("<B><FONT size=2 color=navy>E</B><FONT size=2 color=black> " + $EMail +" | " 
+ "<B><FONT size=2 color=navy>I</B><FONT size=2 color=black> " + $web_address + @CRLF)
$objFile.Write("</FONT></BODY></HTML>" + @CRLF)
$objFile.Close

; ===========================
; This section readsout the current Outlook profile and then sets the name of the default Signature
; ===========================
; Use this version to set all accounts
; in the default mail profile
; to use a previously created signature

SetDefaultSignature("prc-new","")

; Use this version (and comment the other) to
; modify a named profile.
; SetDefaultSignature("Signature Name", "Profile Name")

Function SetDefaultSignature($strSigName, $strProfile)
  Dim $HKEY_CURRENT_USER = &80000001
  $strComputer = "."
  If IsOutlookRunning = 0
    $objreg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" + $strComputer + "\root\default:StdRegProv")
    $strKeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"
    ; get default profile name if none specified
    If $strProfile = ""
      $objreg.GetStringValue($HKEY_CURRENT_USER, $strKeyPath, "DefaultProfile", $strProfile)
    EndIf
    ; build array from signature name
    $myArray = StringToByteArray($strSigName, 1)
    $strKeyPath = $strKeyPath + $strProfile + "\9375CFF0413111d3B88A00104B2A6676"
    $objreg.EnumKey($HKEY_CURRENT_USER, $strKeyPath, $arrProfileKeys)
    For Each $subkey In $arrProfileKeys
      $strsubkeypath = $strKeyPath + "\" + $subkey
      $objreg.SetBinaryValue($HKEY_CURRENT_USER, $strsubkeypath, "New Signature", $myArray)
      $objreg.SetBinaryValue($HKEY_CURRENT_USER, $strsubkeypath, "Reply-Forward Signature", $myArray)
    Next
  Else
    $strMsg = "Please shut down Outlook before running this script."
    $=MessageBox($strMsg, "SetDefaultSignature")
  EndIf
EndFunction

Function IsOutlookRunning()
  $strComputer = "."
  $strQuery = "Select * from Win32_Process Where Name = 'Outlook.exe'"
  $objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" + $strComputer + "\root\cimv2")
  $colProcesses = $objWMIService.ExecQuery($strQuery)
  For Each $objProcess In $colProcesses
    If UCase($objProcess.Name) = "OUTLOOK.EXE"
      $IsOutlookRunning = 1
    Else
      $IsOutlookRunning = 0
    EndIf
  Next
EndFunction

Function StringToByteArray($Data, $NeedNullTerminator)
  Dim $strAll
  $strAll = StringToHex4($Data)
  If $NeedNullTerminator
    $strAll = $strAll + "0000"
  EndIf
  $intLen = Len($strAll) \ 2
  ReDim $arr[$intLen - 1]
  For $i = 1 To Len($strAll) \ 2
    $arr($i - 1) = CByte("&" + Mid($strAll, (2 * $i) - 1, 2))
  Next
  $StringToByteArray = $arr
EndFunction

Function StringToHex4($Data)
  ; Input: normal text
  ; Output: four-character string for each character,
  ; e.g. "3204" for lower-case Russian B,
  ; "6500" for ASCII e
  ; Output: correct characters
  ; needs to reverse order of bytes from 0432
  Dim $strAll
  For $i = 1 To Len($Data)
    ; get the four-character hex for each character
    $strChar = Mid($Data, $i, 1)
    $strTemp = Right("00" + Hex(AscW($strChar)), 4)
    $strAll = $strAll + Right($strTemp, 2) + Left($strTemp, 2)
  Next
  $StringToHex4 = $strAll
EndFunction


Edited by Richard H. (2007-12-03 09:34 AM)
Edit Reason: Long lines broken down a bit for readability

Top
#183187 - 2007-12-03 09:12 AM Re: n00b question... convert from vbs to kix... (again) [Re: Arend_]
Richard H. Administrator Offline
Administrator
*****

Registered: 2000-01-24
Posts: 4945
Loc: Leatherhead, Surrey, UK
 Quote:
You will have to find out a different way of using VB's Hex() function, it is not supported in kixtart


No?

What about the DecToHex() built-in?

Top
#183189 - 2007-12-03 09:14 AM Re: n00b question... convert from vbs to kix... (again) [Re: Richard H.]
Jochen Administrator Offline
KiX Supporter
*****

Registered: 2000-03-17
Posts: 6372
Loc: Stuttgart, Germany
Can't read this thing ... nor scroll through it ... will somebody brake this one long line of code please ?
_________________________



Top
#183196 - 2007-12-03 11:07 AM Re: n00b question... convert from vbs to kix... (again) [Re: NTDOC]
Hotzenwalder Offline
Fresh Scripter

Registered: 2006-01-26
Posts: 26
It would be a very long variable, but thanks for the info... I will give it a try.
Top
#183197 - 2007-12-03 11:11 AM Re: n00b question... convert from vbs to kix... (again) [Re: Hotzenwalder]
NTDOC Administrator Offline
Administrator
*****

Registered: 2000-07-28
Posts: 11564
Loc: CA
 Originally Posted By: Hotzenwalder
It would be a very long variable, but thanks for the info... I will give it a try.


I write an entire multi-page html document for my HelpDesk script using a single line write so it shouldn't be an issue.

Top
#183200 - 2007-12-03 01:18 PM Re: n00b question... convert from vbs to kix... (again) [Re: Richard H.]
Arend_ Moderator Online   sleepy
MM club member
*****

Registered: 2005-01-17
Posts: 1864
Loc: Hilversum, The Netherlands
 Originally Posted By: Richard H.
 Quote:
You will have to find out a different way of using VB's Hex() function, it is not supported in kixtart


No?

What about the DecToHex() built-in?


DecToHex() is not Hex() now is it :P
Wanted him to find some things out for himself :P

Top
Page 1 of 1 1


Moderator:  Glenn Barnas, NTDOC, Arend_, Jochen, Radimus, Allen, ShaneEP, Mart 
Hop to:
Shout Box

Who's Online
1 registered (adamlevine) and 165 anonymous users online.
Newest Members
katherinknul, phamthuy, xuantu075, skygreen2031, amelindarķe
17629 Registered Users

Generated in 0.246 seconds in which 0.108 seconds were spent on a total of 13 queries. Zlib compression enabled.

Search the board with:
superb Board Search
or try with google:
Google
Web kixtart.org