| Hotzenwalder |
| (Fresh Scripter) |
| 2007-11-28 01:50 PM |
n00b question... convert from vbs to kix... (again)
|
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
NTDOC
|
| (KiX Master) |
| 2007-11-28 11:47 PM |
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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?
| Hotzenwalder |
| (Fresh Scripter) |
| 2007-11-29 09:35 AM |
|
Re: n00b question... convert from vbs to kix... (again)
|
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.
|
NTDOC
|
| (KiX Master) |
| 2007-11-29 12:00 PM |
|
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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)| oneill |
| (Fresh Scripter) |
| 2007-11-29 12:43 PM |
|
Re: n00b question... convert from vbs to kix... (again)
|
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
| Hotzenwalder |
| (Fresh Scripter) |
| 2007-11-29 12:48 PM |
|
Re: n00b question... convert from vbs to kix... (again)
|
Thank you... I will give it a spin.
| Hotzenwalder |
| (Fresh Scripter) |
| 2007-11-30 10:26 AM |
|
Re: n00b question... convert from vbs to kix... (again)
|
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.
|
NTDOC
|
| (KiX Master) |
| 2007-11-30 10:53 AM |
|
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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.
| Hotzenwalder |
| (Fresh Scripter) |
| 2007-11-30 11:38 AM |
Re: n00b question... convert from vbs to kix... (again)
|
[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
|
NTDOC
|
| (KiX Master) |
| 2007-11-30 08:33 PM |
|
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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.
| Arend_ |
| (MM club member) |
| 2007-12-01 08:42 PM |
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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
|
Richard H.
|
| (KiX Supporter) |
| 2007-12-03 09:12 AM |
|
Re: n00b question... convert from vbs to kix... (again)
|
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?
|
Jochen
|
| (KiX Supporter) |
| 2007-12-03 09:14 AM |
|
|
Re: n00b question... convert from vbs to kix... (again)
|
Can't read this thing ... nor scroll through it ... will somebody brake this one long line of code please ?
| Hotzenwalder |
| (Fresh Scripter) |
| 2007-12-03 11:07 AM |
|
Re: n00b question... convert from vbs to kix... (again)
|
It would be a very long variable, but thanks for the info... I will give it a try.
|
NTDOC
|
| (KiX Master) |
| 2007-12-03 11:11 AM |
|
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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.
| Arend_ |
| (MM club member) |
| 2007-12-03 01:18 PM |
|
|
|
Re: n00b question... convert from vbs to kix... (again)
|
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