Visual Basic Library

This page was last updated on Tuesday, November 27, 2001
Public Function strPutStamp(ByVal strChar As String, ByVal strStamp As String) As String
' Procedure :   strPutStamp
' Description:  Date-stamp a document by encoding the date in the font-size of space characters
' Copyright:    Chris Greaves Inc.
' Inputs:       A searchable character, a numeric string.
' Returns:      STRING: The stamp
' Assumes:      Nothing
' Side Effects: None.
' Tested:       By the calls shown below.

' ------------------------------------------------------------------------------------
' Date stamping secret codes in documents
' ------------------------------------------------------------------------------------
' These functions can be used to embed a somewhat-secret code within a source document.
' Typical example: you have a document that contains data for an application;
' You want the application to check that the document is valid for the version of the application

' Date-stamp a document by encoding the date in the font-size of space characters.
' Thus, on the 25th of April 1999, we will set the font size of the first eight spaces
' to be 1, 9, 9, 9, 0, 4, 2 and 5 respectively (1999th year, 04th month 25th day).

' Another use would be to encode a signature in a document, such as a Rules table.
' An application could check the signature and determine that, truly, it *is* a Rules table,
'   and if not, could ask the user if they want to sign it as such.
    
    Dim intCount As Integer
    intCount = Len(strStamp)
    Dim intI As Integer
    Dim intSize As Integer
    Selection.HomeKey unit:=wdStory ' always use the start of document
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = strChar ' typically the space character (asc 032)
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Dim strResult As String
    intI = 0
    While intI < intCount And Selection.Find.Execute
        intI = intI + 1
    Wend
    If intI < intCount Then ' we did not find enough characters.
    ' Let's place some at the end of the document.
        Selection.EndKey unit:=wdStory
        Selection.TypeText String(intCount - intI, strChar)
    Else
    End If
    Selection.HomeKey unit:=wdStory
    intI = 0
    While intI < intCount And Selection.Find.Execute
        intSize = Val(Left(strStamp, 1)) + intCount ' avoid zero-size fonts
        With Selection.Font
            .size = intSize
        End With
        strResult = strResult & Selection.Text
        strStamp = Right(strStamp, Len(strStamp) - 1) ' exhaust the stamp string
        intI = intI + 1
    Wend
    strPutStamp = strResult
'Sub TESTstrPutStamp()
'   When you run this function there will be little obvious change in the current Word Document.
'   However if you have the Format toolbar visible (View, Toolbars, Format)
'       and skip to the right of each space character, you should see the font size change to reflect today's date.
'
'   I last tested this on November 24th 2001; we represent the date in YYYYMMDD format,
'       so: 20011124, but then we add the length of the string (8 characters) to each digit
'       so: 10, 8, 8, 9, 9, 9, 10, 12
'       and these are the font sizes of the first eight space characters in my document.
'    MsgBox Len(strPutStamp(" ", strNow("YYyymmdd")))
'End Sub
End Function