saint_monkey

I used to love the website blather. The concept was (and is, i guess,) cool. you put an entry in, and the system sorted it and linked each word in the entry to titled entries containing the same word. ie: you write the word "jesus" in an entry about frat boys, and the word "jesus" would automatically become a hyperlink to the entry about "jesus." When i found that i could pull and parse the latest.bml entries from livejournal, I began writing a tool that could "Blatherize" a journal entry... it groups words in sets of five, searches for the phrase, then in sets of four, etc, down to one. if it finds a match, say "nothing better to do" in any of the latest posts, then it makes a link to the entry. here it is at work on dagoski's latest post:
( Read more... )

this is another vba program intended to go into my "vba portfolio"

this is a use of the concept expressed in adcott's journal. Specifically this post. Adcott is wicked smart. I've stayed as true as i could to the concept, using excel to calculate the three sine waves and vba to call the Windows API and drop the appropriate colors to windows. (watch for text wrapping, although i've used the teletype html tag, which should prevent it.)

how to use:
1) open excel, create a new workbook.
2) hit Alt-Function11 (this will open the Visual Basic Editor) (or tools>macro>macros>type auto_open in "Macro Name" and hit "create.")
3) paste all of the code below into the module.
4) "x" out of the visual basic editor
5) save the workbook

6) whenever you open the excel file, be sure to "enable macros." upon opening, the book will change the desktop colors to colors fitting adcott's original program. (since these colors are just dropped to the stack and not really called by any windows program, they won't stay after shutdown unless you go into the Desktop control panel and save them, so they are "volatile..." which is nice if you futz with the code and set all the rgb values for all the variables to zero or something equally as prankish. just reboot and anything funky disappears.) if you run this many times in a row, it will eat the stack space and windows will crash. DISCLAIMER: if you hit Alt-Tab in the middle of the API calls, you can crash some older windows networks. (REAL old networks, we are talking win 3.11 era here.) the chances of it affecting a modern network are slim to none, but i don't want to be blamed for any screwups.

BEGIN CODE!

' DONT TOUCH From Here to Below, !
' we are declaring objects that will control each aspect
' of the windows appearance GUI

Declare Function SetSysColors Lib "user32" _
(ByVal nChanges As Long, lpSysColor As _
Long, lpColorValues As Long) As Long


Public Const COLOR_SCROLLBAR = 0 'The Scrollbar color'
Public Const COLOR_BACKGROUND = 1 'Color of the background with no wallpaper'
Public Const COLOR_ACTIVECAPTION = 2 'Caption of Active Window'
Public Const COLOR_INACTIVECAPTION = 3 'Caption of Inactive window'
Public Const COLOR_MENU = 4 'Menu'
Public Const COLOR_WINDOW = 5 'Windows background'
Public Const COLOR_WINDOWFRAME = 6 'Window frame'
Public Const COLOR_MENUTEXT = 7 'Window Text'
Public Const COLOR_WINDOWTEXT = 8 '3D dark shadow (Win95)'
Public Const COLOR_CAPTIONTEXT = 9 'Text in window caption'
Public Const COLOR_ACTIVEBORDER = 10 'Border of active window'
Public Const COLOR_INACTIVEBORDER = 11 'Border of inactive window'
Public Const COLOR_APPWORKSPACE = 12 'Background of MDI desktop'
Public Const COLOR_HIGHLIGHT = 13 'Selected item background'
Public Const COLOR_HIGHLIGHTTEXT = 14 'Selected menu item'
Public Const COLOR_BTNFACE = 15 'Button'
Public Const COLOR_BTNSHADOW = 16 '3D shading of button'
Public Const COLOR_GRAYTEXT = 17 'Grey text, of zero if dithering is used.
Public Const COLOR_BTNTEXT = 18 'Button text'
Public Const COLOR_INACTIVECAPTIONTEXT = 19 'Text of inactive window'
Public Const COLOR_BTNHIGHLIGHT = 20 '3D highlight of button'
Public Const COLOR_2NDACTIVECAPTION = 27 'Win98 only: 2nd active window color
Public Const COLOR_2NDINACTIVECAPTION = 28 'Win98 only: 2nd inactive window color

Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long

'END OF DON"T TOUCH

Sub Auto_open()
' concept from http://www.livejournal.com/users/adcott/340917.html
' derive a julian day from the date, and express this as
' a function of three superimposed sine waves
' each wave representing the respective rgb values in a RGB color
' each color would correspond to the respective season
' (in the northern hemisphere.) blues correspond to winter
' greens for springs, yellows are summer, orange and red for fall
' purples/blues back to winter again.


'red at zero, green at neg 365 blue at 365 produces the truest effect
'to adcott's original hypothesis
Dim jday1 As Date
Dim jday As Date
Dim redphase as integer
Dim bluephase as integer
Dim greenphase as integer
dim test as variant
dim black as integer
dim white as integer
dim red as integer
dim green as integer
dim blue as integer

redphase = 0
greenphase = 365
bluephase = -365



jday1 = Date

' uncomment the lines below for the ability to allow
' the user to enter the date
'jday1 = InputBox("Date?")
'test = IsDate(jday1)
'If test <> True Then Exit Sub
''''''''end of lines to uncomment.

jday = CDate2Julian(jday1)

red = Int(128 * Sin(2 * 3.14 * 6 * jday + redphase * 3.14)) + 128
green = Int(128 * Sin(2 * 3.14 * 6 * jday + greenphase * 3.14)) + 128
blue = Int(128 * Sin(2 * 3.14 * 6 * jday + bluephase * 3.14)) + 128
black = Abs(Int(blue * 0.1))
white = Abs(Int(blue / 0.1))

Select Case white
'don't let "white" get darker than 25% grey
Case Is < 190
white = white + 190
End Select

Select Case black
'don't let "black" get lighter than 75% grey
Case Is > 100
black = black - 100
End Select

'Titlebars
t& = SetSysColors(1, COLOR_ACTIVECAPTION, RGB(red, green, blue))
t& = SetSysColors(1, COLOR_ACTIVEBORDER, RGB(Abs(Int(red / 10)), Abs(Int(green / 10)), Abs(Int(blue / 10))))
t& = SetSysColors(1, COLOR_CAPTIONTEXT, RGB(white, white, white))
t& = SetSysColors(1, COLOR_INACTIVECAPTION, RGB(Abs(Int(red / 2)), Abs(Int(green / 2)), Abs(Int(blue / 2))))
t& = SetSysColors(1, COLOR_INACTIVEBORDER, RGB(Abs(Int(red / 10)), Abs(green / 10), Abs(blue / 10)))

t& = SetSysColors(1, COLOR_INACTIVECAPTIONTEXT, RGB(Abs(Int(blue / 0.1)), Abs(Int(blue / 0.1)), Abs(Int(blue / 0.1))))

'Button
t& = SetSysColors(1, COLOR_BTNTEXT, RGB(black, black, black))
't& = SetSysColors(1, COLOR_BTNFACE, RGB(192, 192, 192))
t& = SetSysColors(1, COLOR_BTNFACE, RGB(190 + Abs(Int(red / 10)), 190 + Abs(Int(green / 10)), 190 + Abs(Int(blue / 10))))

't& = SetSysColors(1, COLOR_BTNSHADOW, RGB(50 + Abs(Int(red / 10)), 50 + Abs(Int(green / 10)), 50 + Abs(Int(blue / 10))))
t& = SetSysColors(1, COLOR_BTNSHADOW, RGB(220 + Abs(Int(red / 10)), 220 + Abs(Int(green / 10)), 220 + Abs(Int(blue / 10))))
t& = SetSysColors(1, COLOR_BTNHIGHLIGHT, RGB(220 + Abs(Int(red / 10)), 220 + Abs(Int(green / 10)), 220 + Abs(Int(blue / 10))))
'Textwindow
t& = SetSysColors(1, COLOR_WINDOW, RGB(white, white, white))
t& = SetSysColors(1, COLOR_SCROLLBAR, RGB(red, green, blue))
t& = SetSysColors(1, COLOR_WINDOWTEXT, RGB(black, black, black))
t& = SetSysColors(1, COLOR_WINDOWFRAME, RGB(black, black, black))
'Background
t& = SetSysColors(1, COLOR_BACKGROUND, RGB(Abs(Int(red * 0.9)), Abs(Int(green * 0.9)), Abs(Int(blue * 0.9))))
t& = SetSysColors(1, COLOR_APPWORKSPACE, RGB(Abs(Int(red * 0.5)), Abs(Int(green * 0.5)), Abs(Int(blue * 0.5))))
'Menus
t& = SetSysColors(1, COLOR_MENU, RGB(190 + Abs(Int(red / 10)), 190 + Abs(Int(green / 10)), 190 + Abs(Int(blue / 10))))
t& = SetSysColors(1, COLOR_MENUTEXT, RGB(black, black, black))
t& = SetSysColors(1, COLOR_GREYTEXT, RGB(Abs(Int(red / 3)), Abs(Int(green / 3)), Abs(Int(blue / 3))))
t& = SetSysColors(1, COLOR_HIGHLIGHT, RGB(Abs(Int(red * 0.5)), Abs(Int(green * 0.5)), Abs(Int(blue * 0.5))))
t& = SetSysColors(1, COLOR_HIGHLIGHTTEXT, RGB(white, white, white))


End Sub

Function CDate2Julian(MyDate As Date) As String

CDate2Julian = Format(MyDate - DateSerial(Year(MyDate) - 1, 12, _
31), "000")

End Function


'END CODE.

excel has really crappy password protection for worksheets. passwords you enter are re-hashed by the computer and truncated to 12 digit strings, a good password cracker, like the one featured here:

http://www.mcgimpsey.com/excel/removepwords.html

can undo any protection you've placed on your worksheets in about two minutes,

as an illustration of this, and as an equally stupid method of protecting a worksheet, the first macro takes a character string and converts it into a color range on a worksheet. the second macro reads that string and your inputted password, and tells you if you have it right, or in this case, close. it is possible to shake things up a bit, since this password can be any length, and the seed is varied based upon user entry as well. of course it is quite easy to see how large the password is, as long as you know that the colored range corresponds to the size of the password. decyption could get hard, especially if the main page is full of random colors, and if only the decryption macro is in the target workbook.


Sub Code2Color()
'turns a password into a range of colored cells.
'
inp2cde = InputBox("Enter codestring")
lenstrin = Len(inp2cde)
if lenstrin < 7 then exit sub
seed = InputBox("Enter multiplier")
Count = 0
For x = 1 To lenstrin
Count = Count + 1
str2cde = Right(inp2cde, 1)
str2clr = Left(str2cde, 1)
numval = Asc(str2clr)


numval = Int(numval / seed)

ColVal = numval
Range("I" & Count).Interior.ColorIndex = ColVal


Next x
End Sub

Sub Color2Code()
' compliment to code2color, turns a range
' of cell interiors into a password
success = 1
Count = 0

inp2cde = InputBox("Enter your code")
lenstrin = Len(inp2cde)
if lenstrin < 7 then exit sub
seed = InputBox ("Enter multiplier")

For x = 1 To lenstrin

Count = Count + 1
str2cde = Right(inp2cde, 1)
str2clr = Left(str2cde, 1)
numval = Int(Asc(str2clr) / seed)

ColVal = Range("I" & Count).Interior.ColorIndex

If ColVal = numval Then
success = 0
Else
success = 1
End If

Next x
Select Case success
Case "0"
MsgBox "yup"
Case Else
MsgBox "nope"
End Select
End Sub

another macro for an online resume of vba. this one is reversi in an excel worksheet, complete with three separate opponent AI's. this one needs a lot of cleaning up, it has a lot of spaghetti in it, but i couldn't get the logic worked out any other way. it needs some work in the "Invalid Move" department, and it also needs to detect an opponent's pass better, now i work out a pass by changing cell value in A1 from W to B manually. but i don't want to lose the code, so here it is:

( more vba code )