Nov 20 2008

AD Based Outlook Email Signature for 2003 and 2007 Part 4 – Now writes TXT and RTF as well as HTML

Ok due to high demand, and for some very odd reason 2007 was not writing the .txt file and the .rtf.

Now I have implemented various changes so it does this, however due to time constraints its not as
automated as I would like, I will try to review this when I get some free time (hopefully :) ).

So if you are using the old script the only changes are:

‘=========================================================
‘ This adds the Text file, will need to be changed accordingly
‘==========================================================

Set objFile = objFSO.CreateTextFile(Folderlocation&”Elcom.txt”,True)
objfile.writeLine “”& FullName & ” | ” & title & ” |  ” & title & ” | “& Company & ” | Australian Technology Park”
objfile.writeLine “T +612 ” & PhoneNumber & ” | F +612 9209 4423 | www.elcom.com.au | ” & Email &” ”
objfile.writeLine ” ”
objfile.writeLine ” ”
objfile.writeLine “——————————————————————————–”
objfile.writeLine “This email is intended for the intended recipients(s) and may contain confidential information. ”
objfile.writeLine “Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender.”
objfile.writeLine “If you are not the intended recipient, please notify the sender immediately and you must not read,”
objfile.writeLine “keep, use, disclose, copy or distribute this email without the sender’s prior permission.”
objfile.writeLine “The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd ”
objFile.Close

as you can see I have had to write this out again (without the HTML tags), this is far from perfect but
it is a working fix for the time being. You will have to edit the above to suite your Text based
Signature.

Next addition is

‘====================================================
‘ This copies the .htm file and changes it to a RTF format
‘====================================================

‘Set the Source and Destination paths below – CHANGE your file name
‘—————————————————-

Const OverwriteExisting = True
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
objFSO.CopyFile Folderlocation & “Elcom.htm” , Folderlocation & “Elcom.rtf”, OverwriteExisting 

Being that RTF will show a HTML format this is any easy fix, all you have to do with this is change the
file name which we set in the begining of the script. So for example I would change “Elcom.htm” to
“MyCompany.htm”

  Here is the complete code

 
 
'====================
'
' VBScript: <Signatures.vbs>
' AUTHOR: Peter Aarts
' Contact Info: peter.aarts@l1.nl
' Version 2.04
' Date: January 20, 2006
' Moddified By Brad Marsh Now works with both 2003 and 2007 outlook 
' Contact: gentex@tpg.com.au
' Date 19 feb 08
' Tested on Vista, XP, XP64 and office 2003 and 2007. 
' NOTE will not work that well with various email accounts

' Additions added on 20 Nov 08 - Tested on Office 07 and Vista 
'====================  
 
'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.elcom.com.au"
 
' 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, RegKey07, RegKeyParm
Set objShell = CreateObject("WScript.Shell")
RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"
RegKey07 = "HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\General"
RegKey07 = RegKey07 & "\Signatures"
RegKey = RegKey & "\Signatures"
objShell.RegWrite RegKey , "AD_elcom"
objShell.RegWrite RegKey07 , "AD_elcom"
UserDataPath = ObjShell.ExpandEnvironmentStrings("%appdata%")
FolderLocation = UserDataPath &"\Microsoft\AD_elcom\"
HTMFileString = FolderLocation & "Elcom.htm"
 
' This section disables the change of the signature by the user.
'====================
'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\NewSignature" , "L1-Handtekening"
'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\MailSettings\ReplySignature" , "L1-Handtekening"
'objShell.RegWrite "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail\EnableLogging" , "0", "REG_DWORD"  
 
' 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&"Elcom.rtf")
aFile.Delete
Set AFile = objFSO.GetFile(Folderlocation&"Elcom.txt")
aFile.Delete
 
'=========================================================
' This adds the Text file, will need to be changed accordingly
'========================================================== 
 
Set objFile = objFSO.CreateTextFile(Folderlocation&"Elcom.txt",True)
objfile.writeLine ""& FullName & " | " & title & " |  " & title & " | "& Company & " | Australian Technology Park"
objfile.writeLine "T +612 " & PhoneNumber & " | F +612 9209 4423 | www.elcom.com.au | " & Email &" "
objfile.writeLine " "
objfile.writeLine " "
objfile.writeLine "--------------------------------------------------------------------------------"
objfile.writeLine "This email is intended for the intended recipients(s) and may contain confidential information. "
objfile.writeLine "Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender."
objfile.writeLine "If you are not the intended recipient, please notify the sender immediately and you must not read,"
objfile.writeLine "keep, use, disclose, copy or distribute this email without the sender's prior permission."
objfile.writeLine "The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd "
objFile.Close
 
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>" & vbCrLf
objfile.write "<font color=696969 face=" & aQuote & "Arial" & aQuote & "><h6> "& FullName & " | " & title & " | "& Company & " | Australian Technology Park <br>"& vbCrLf
objfile.write "T +612 " & PhoneNumber & " | F +612 9209 4423 | <a href=http://www.elcom.com.au><font color=#696969>www.elcom.com.au</font></a> |<a href=mailto:" & Email &" > <font color=#696969>" & Email &" " & vbCrLf
objfile.write "</h6></font></a></B>" & vbCrLf
objfile.write "</font>" & vbCrLf
objfile.write "<font color=696969 face=arial><A href=http://www.elcom.com.au/> <img src=http://www.elcom.com.au/images/elcom-logo-web-175x70.gif border=0></a>" & vbCrLf
objfile.write "<br>" & vbCrLf
objfile.write "<img src=http://www.elcom.com.au/images/mspartner.jpg>" & vbCrLf
objfile.write "<br>" & vbCrLf
objfile.write "</font><font color=696969 size=1 face=arial><br>" & vbCrLf
objfile.write "<hr size=1 align=left width=465 color=696969>" & vbCrLf
objfile.write " This email is intended for the intended recipients(s) and may contain confidential information. <br> Reproduction, dissemination or distribution of this message is prohibited unless authorised by the sender.<br> If you are not the intended recipient, please notify the sender immediately and you must not read,<br> keep, use, disclose, copy or distribute this email without the sender's prior permission.<br> The views expressed by the sender are not necessarily those of Elcom Technology Pty Ltd</font>"  & vbCrLf
objfile.write "</FONT></BODY></HTML>" & vbCrLf
objFile.Close
 
'==========================================================================
' This copies the .htm file and changes it to a RTF format
'==========================================================================
'Set the Source and Destination paths below - CHANGE your file name
'---------------------------------------------------- 
 
Const OverwriteExisting = True
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile Folderlocation & "Elcom.htm" , Folderlocation & "Elcom.rtf", OverwriteExisting
 
' ===========================
' 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("Elcom","")
 
' 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

Enjoy

34 comments | posted in Microsoft, Software, Techie, Vista

Nov 13 2008

Changing your window Mobile Keyboard Layout

Recently I applied another ROM (yes another one seem as though I am changing ROM’s as often as my undies) because I am sick of waiting for windows mobile 7.

So anyway’s I found myself an AWSOME windows mobile 6.1 rip off of the HTC touch series (diamond, PRO and HD)

called HTC_HERMES_S64_WM_6.1_TouchFlo2D_UC_ WWE v5 / GER v1 BIG THANKS to:

_Alex_, A_C, abusalza, anichillus, anryl, bennec83, Bepe, bluemetalaxe, CRCinAu,
dotfred, Dr Puttingham, dutty, duttythroy, efrost, gullum, herg62123, kin0kin,
Koterpillar, l3v5y, lagoskon, lepsyfou, levenum, Lordsmiff, MaRaHoX, Martie, mattk_r
Mort, mrvanx, N2A, no2chem, patr!k, PaY87, poorlyduck, Rhapsody, s.l.i, sakajati,
schaps, schen, Shamanix, shogunmark, Slither2006, tadzio, zocster
with friendly greet
Starbase64

Awesome ROM

Anyway’s, if you are like me and have the good old Dopod 838 Pro, and loaded a new ROM on that is a different country; you might have some keyboard problems.

First problem you might find is that it might not be the QWERTY keyboard but a QWERTZ (German).

Second is that you will find characters more accurately punctuation all over the place , which is just annoying when your in a rush to type something up.

So in order to fix these problems you are going to need a registry editor for your device, there are many around that are free. But I recently stumbled across one that runs as an .exe from a desktop machine, and when your device is in sync it will read from it and allow you to modify the registry, this works perfectly you can find it here

Once you see the registry up and running you need to change the following registry keys:

HKEY_LOCAL_MACHINE\Software\Oem\Qwerty

“layout” = “132105″

HKEY_CURRENT_USER\keyboard layout\Preload\

“Default”=”e0010409″

HKEY_CURRENT_USER\keyboard layout\Preload\1

“Default”=”e0010409″

restart your PDA.

DONE, you now have your keyboard back to normal

If you have another phone the below could possibly help you

http://forum.xda-developers.com/showthread.php?t=428597

11 comments | posted in Microsoft, Techie, Windows Mobile, gadgets

Nov 12 2008

Setting up Linked Servers Between MYSQL and MSSQL

Creating a Linked Server in MSSQL for a MySQL database
1. Download the MySQL ODBC driver from mysql.com (download from here) and Install MySQL ODBC driver on the MSSQL Server

2. Create a DSN using the MySQL ODBC driver

Start > Settings > Control Panel > Administrative Tools > Data Sources (ODBC)

> Click on the System DSN tab
> Click Add
>Select the MySQL ODBC Driver
> Click Finish

On the Login Tab:
> Type a name for your DSN.
> Type the server name or IP Address into the Server text box.
> Type the username needed to connect to the MySQL database into the user text box.
> Type the password needed to connect to the MySQL database into the password text box.
> Select the database you want to be able link to.

> make sure you test your DSN by Clicking the ‘Test’ button

NOTES: If your test was unsuccessful, you may need to add the server you are connecting from to the allowed list, and ensure the user you are using has privileges to the database you are trying to link to

3. Creating a Linked Server in SSMS (SQL Server Management Studio) for the MySQL database

there is 2 ways of doing this,

1. Using the GUI

SSMS (SQL Server Management Studio -> Expand Server Objects
> Right Click Linked Servers -> Select New Linked Server
On the General Page:
> Linked Server: Type the Name for your Linked Server
> Server Type: Select Other Data Source
> Provider: Select Microsoft OLE DB Provider for ODBC Drivers
> Product name: Type MySQLDatabase
> Data Source: Type the name of the DSN you created
On The Security Page
> Map a login to the Remote User and provide the Remote Users Password
> Click Add under Local server login to remote server login mappings:
> Select a Local Login From the drop down box
> Type the name of the Remote User
> Type the password for the Remote User

OR

2. through TSQL

– Add Linked Server
EXEC sp_addlinkedserver ‘mysqlDB’, ‘MySQL’, ‘MSDASQL’, Null, Null, ‘Driver={MySQL ODBC 5.1 Driver};DB=[DB_NAME];SERVER=[HOSTNAME];uid=[USER];pwd=[PASSWWORD]‘


Note: Change items enclosed with [  ] and the bold Items

Now test your linked server

if you are unable to connect there could be sevral problems here are a few things to check

Expand Providers > Right Click MSDASQL > Select Properties
> Enable Nested queries (not needed but handy)
> Enable Level zero only (this one’s the kicker)
> Enable Allow inprocess (this is a MUST)
> Enable Supports ‘Like’ operator (not needed but handy)

Change settings in SQL Server Surface Area Configuration for Features
> Enable OPENROWSET and OPENDATASOURCE support.

Restart SQL Server and SQL Server Agent

Run this TSQL (using the master database)

– Set up login mapping using current user’s security context
EXEC sp_addlinkedsrvlogin
@rmtsrvname = ‘mySQLDB‘,
@useself = ‘TRUE’,
@locallogin = NULL
GO

 
Note: change the bold items

Ok so now you should be able to connect

use this to ensure you can query you Link server

– List the tables on the linked server
EXEC sp_tables_ex ‘mysqlDB’
GO

 Note: change the bold items

 

Now if you need to query your table, you cant use the typical select statements, like

SELECT * FROM data.data1..test
or
SELECT * FROM data.data1.user.test

 

Seems as though not everything is exposed properly, your not going crazy!

using something like this will work

SELECT * FROM OPENQUERY(data, ‘SELECT * FROM TEST’)

 

this link explains it a lot better :)

http://benjolo.com/blog/2003/08/27/mysql-mssql-linked-tables-or-just-kill-me-now/

5 comments | posted in Microsoft, SQL Server, Software, Techie

Nov 3 2008

File Server Resource Manager not saving.

Today I was getting a strange error from the file server Resource manager when I was trying to save a quota, but upon the save I was getting the following error:

“The Quota Management Filter Driver Service or File Screening Filter Driver service is not running”

Simple fix is:

open a command line

start > run > type  ‘cmd’

then type
‘fltmc filters’  – (this command will check which filters are activated)

you should see 4 items if you only see 2 then you are missing a few things:

If Quota is missing type the following at the command prompt.

‘fltmc load Quota ‘

If Datascrn is missing type the following at the command prompt.
fltmc load Datascrn

Now you should be able to access the File Screen in the File Screening Management, and save your quotas etc.

7 comments | posted in Microsoft, Software, Techie