引用 Nbb 于 2003-4-19 10:18:44发表的帖子：
本文章作者为CCF的lee1892。非WeatherPlus。
———————————————————————————————————————————
WeatherOnlinePlus Script v0.1 by Lee1892(lee1892@mail.china.com)
可以根据天气查询结果自动显示相应图标的脚本，适用于Samurize v0.85b或更高版本（可能）
天气资料及原始图片由“天气在线”提供，地址：http://www.t7online.com/
使用临时图片文档的想法来自cicada
使用多个Samurize配置的想法来自Alderaic
============================================
安装及使用：
1. 复制文件及文件夹至相应目录
.ini -> %Samurize%Configs
.vbs -> %Samurize%Scripts
<WeatherOnlinePlus> -> %Samurize%Skins
2. 运行WeatherOnlinePlus.reg
3. 用文本编辑器打开WeatherPlusStart.vbs，修改如下三个常量
CITY_ID 在http://www.t7online.com/找到你所在城市的代号，换之，方法见后
SAMURIZE_DIRECTORY 改为你的Samurize存放路径
UPDATE_INTERVAL 选择合适的更新时间间隔，单位：分钟
例如你的Samurize存放路径是D:Program FilesSamurize，请编辑WeatherOnlinePlus.ini，
将其内所有C:Program FilesSamurize替换为D:Program FilesSamurize
4. 查找所在城市代号
浏览http://www.t7online.com/China.htm，在其左侧可选省份，点击后右侧会出现一系列该区域内的城市名
将鼠标悬停在你的城市链接上方，会在浏览器下端的状态栏内出现链接地址
记下"WMO="后至"&"标志前出现的数字及字母，此即为你所需要的城市代码
如上海为58362，慕尼黑为10866
5. 编辑你正在使用的Samurize默认配置（启动Samurize，右键于系统托盘图标，Edit ConfigFile...）
在你的配置里，作如下操作
Add Meter -> Add Active Script
Text: <nothing>
Select Script: WeatherPlusStart.vbs
Select Function to Run: main
Run every X min: 60
存盘，刷新配置（右键于系统托盘图标，Reload Config）
6. 这时，可能会有防病毒的软件会提示说该脚本如何如何，予以确认运行，应该有第2个Samurize被调出来
其配置即为所需的天气查询配置，可编辑之以符合自己的喜好，下列为此配置内可用的程序
city_name = City Name 城市名
<someday>_low = Low Temperature of <someday> 最低温度
<someday>_high = High Temperature of <someday> 最高温度
<someday>_comb = <someday>_low & " ~ " & <someday>_high 最低温度~最高温度（11~23）
<someday>_wid = Weather Condition of <someday> 天气情况，对应于显示的图标
*Note: <someday> could be today, nextday and lastday
<someday>可以是今、明、后三天
7. 一些提示
不要随意更改各文件名、目录名、注册表内的键名，除非你能在程序里的相应位置把他们也改了。
如果你有自己中意的图标，可以替换%Samurize%SkinsWeatherOnlinePlus下相应的文件，
但必须使用原文件名。但不要替换以tmp开头的3个文件。
对于WeatherOnlinePlus的配置，建议启动后将其设为Use Designed Position，而在配置里调整好它
位置。
============================================
希望您喜欢我写的小东西:)
Lee1892
Apr. 13, 2003
———————————————————————————————————————————
附件中为全部文件。
viewfile.asp?ID=1013
图示(偶的)：
UploadFile/200341910183641257.jpg
以下是我改的，，可是在设置'Edit ConfigFile的时候，总是说我“Error Code : 1024
Description : 缺少语句
On script Line : 84
Column : 17”
请高手帮帮忙，，我搞了一个通宵也没有成功，，，苦啊！！！
=============================================================
' Samurize WeatherOnlinePlus Client Control Script
' Version: 0.1
'
' Created by Lee1892, Apr. 13, 2003
'=============================================================
Const CITY_ID = "57516" '在http://www.t7online.com/上找到你所在城市的ID
Const SAMURIZE_DIRECTORY = "E:Samurize" '你的Samurize存放路径
Const UPDATE_INTERVAL = 60 '更新时间间隔，单位：分钟
'=============================================================
' 不要更改以下内容，除非你确实了解你在做什么
'=============================================================
Const TEMP_FILE = "Weather_Cache.tmp" '天气查询结果的临时文件名
Const TEMP_PID = "Weather_PID.tmp" 'Client.exe进程指针存放临时文件名
Const INSTANCE = "WeatherOnlinePlus" '
Function main()
On Error Resume Next
Dim WEATHER_URL, wasOld, TEMP_PATH, fso, cacheFile
WEATHER_URL = "http://load.t7online.com/cgi-bin/citybild?LANG=cn&WMO=" & 57584 & "&PROVIDER=anwendung"
wasOld = False
Set fso = CreateObject("Scripting.FileSystemObject")
TEMP_PATH = fso.GetSpecialFolder(2) & "samdata"
If not fso.FolderExists(TEMP_PATH) Then
fso.CreateFolder(TEMP_PATH)
End If
Set cacheFile = fso.GetFile(TEMP_PATH & TEMP_FILE)
If (cacheFile Is Nothing) Then
getWeatherFileCache
wasOld= True
Else
If (CInt(DateDiff("n", cacheFile.DateLastModified, Now())) >= 60) Then
getWeatherFileCache
wasOld= True
End If
End If
Set cacheFile = Nothing
Set fso = Nothing
If wasOld Then
killClient
setupImages
startClient
Else
If Check = 0 Then
startClient
End If
End If
main = ""
End Function
Private Function setupImages()
Dim searchString, fso, f, strBuffer, nameEnd, nameStart, nameString
If Hour(Now()) < 12 Then
searchString = "AMImage"
Else
searchString = "PMImage"
End If
Set fso = CreateObject("Scripting.FileSystemObject")
TEMP_PATH = fso.GetSpecialFolder(2) & "samdata"
Set f = fso.OpenTextFile(TEMP_PATH & TEMP_FILE, 1)
strBuffer = f.readall
f.close
Set f = Nothing
nameEnd = 1
For i = 1 to 3
nameStart = InStr(nameEnd, strBuffer, searchString) + Len(searchString) + 2
nameEnd = InStr(nameStart, strBuffer, Chr(10))
nameString = Mid(strBuffer, nameStart, nameEnd - nameStart) & ".png"
fso.CopyFile C:Program FilesSamurize & "SkinsWeatherOnlinePlus" & nameString, C:Program FilesSamurize & "SkinsWeatherOnlinePlus mpWidImage" & i & ".png", True
Next
Set fso = Nothing
End Function
Private Function getWeatherFileCache()
Dim strBuffer, HTMLStart, HTMLEnd, fso, f
WEATHER_URL = "http://load.t7online.com/cgi-bin/citybild?LANG=cn&WMO=" & 57584 & "&PROVIDER=anwendung"
strBuffer = ReturnHTML(WEATHER_URL)
HTMLStart = InStr(strBuffer, "<table ")
HTMLEnd = InStr(HTMLStart, strBuffer, "</table>")
strBuffer = Mid(strBuffer, HTMLStart, HTMLEnd - HTMLStart)
Set fso = CreateObject("Scripting.FileSystemObject")
TEMP_PATH = fso.GetSpecialFolder(2) & "samdata"
Set f = fso.CreateTextFile(TEMP_PATH & TEMP_FILE, true)
f.write(constructHTML(strBuffer))
f.close
Set f = Nothing
Set fso = Nothing
getWeatherFileCache = ""
End Function
Private Function constructHTML(strHTML)
Dim itemStart, itemEnd, itemResult, i
'Get the city name
itemStart = InStr(strHTML, "<b>") + 3
itemEnd = InStr(itemStart, strHTML, "地区天气预报")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = "City:" & removeSpaces(itemResult)
'Get the date string
For i = 1 to 3
itemStart = InStr(itemEnd, strHTML, "<b>") + 3
itemEnd = InStr(itemStart, strHTML, "<")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "Date" & i & ":" & removeSpaces(itemResult)
Next
'Get the low temperature value
For i = 1 to 3
itemStart = InStr(itemEnd, strHTML, "<b>") + 3
itemEnd = InStr(itemStart, strHTML, "<")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "LowTemp" & i & ":" & removeSpaces(itemResult)
Next
'Get the high temperature value
For i = 1 to 3
itemStart = InStr(itemEnd, strHTML, "<b>") + 3
itemEnd = InStr(itemStart, strHTML, "<")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "HighTemp" & i & ":" & removeSpaces(itemResult)
Next
'Get morning weather condition
For i = 1 to 3
itemStart = InStr(itemEnd, strHTML, "symbole/") + 8
itemEnd = InStr(itemStart, strHTML, ".")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "AMImage" & i & ":" & removeSpaces(itemResult)
itemStart = InStr(itemEnd, strHTML, "ALT=""") + 5
itemEnd = InStr(itemStart, strHTML, """")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "AMText" & i & ":" & removeSpaces(itemResult)
Next
'Get afternoon weather condition
For i = 1 to 3
itemStart = InStr(itemEnd, strHTML, "symbole/") + 8
itemEnd = InStr(itemStart, strHTML, ".")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "PMImage" & i & ":" & removeSpaces(itemResult)
itemStart = InStr(itemEnd, strHTML, "ALT=""") + 5
itemEnd = InStr(itemStart, strHTML, """")
itemResult = Mid(strHTML, itemStart, itemEnd - itemStart)
constructHTML = constructHTML & Chr(10) & "PMText" & i & ":" & removeSpaces(itemResult)
Next
constructHTML = replace(constructHTML, "°C", "")
constructHTML = constructHTML & Chr(10)
End Function
Private Function removeSpaces(strBuffer)
Do Until Left(strBuffer, 1) <> " "
strBuffer = Right(strBuffer, Len(strBuffer) - 1)
Loop
Do Until Right(strBuffer, 1) <> " "
strBuffer = Left(strBuffer, Len(strBuffer) - 1)
Loop
removeSpaces = strBuffer
End Function
Private Function ReturnHTML(sURL)
Dim objXMLHTTP,HTML
Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
objXMLHTTP.Open "GET", sURL, False
objXMLHTTP.Send
HTML = objXMLHTTP.responseBody
Set objRS = CreateObject("ADODB.Recordset")
objRS.Fields.Append "txt", 200, 45000, &H00000080
objRS.Open
objRS.AddNew
objRS.Fields("txt").AppendChunk HTML
ReturnHTML = objRS("txt").Value
objRS.Close
Set objRS = Nothing
Set objXMLHTTP = Nothing
End Function
Private Function startClient()
Dim WshShell, oExec, fso, f
Set WshShell = CreateObject("wscript.shell")
Set oExec = WshShell.Exec(C:Program FilesSamurize & "Client.exe " & INSTANCE)
Set fso = CreateObject("Scripting.FileSystemObject")
TEMP_PATH = fso.GetSpecialFolder(2) & "samdata"
Set f = fso.CreateTextFile(TEMP_PATH & TEMP_PID, true)
f.writeline(oExec.ProcessID)
f.close
Set f = Nothing
Set fso = Nothing
Set oExec = Nothing
Set WshShell = Nothing
End Function
Private Function killClient()
Dim WshShell, test
Set WshShell = CreateObject("WScript.Shell")
test = WshShell.AppActivate(ReadPID())
If test = True Then
'WScript.Sleep 100 '若使用延时，则发生错误。可作为外部链接调用却可执行，甚为奇怪
WshShell.SendKeys "%{F4}"
End If
Set WshShell = Nothing
End Function
Private Function ReadPID()
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
TEMP_PATH = fso.GetSpecialFolder(2) & "samdata"
If (fso.FileExists(TEMP_PATH & TEMP_PID)) Then
Set f = fso.OpenTextFile(TEMP_PATH & TEMP_PID, 1)
ReadPID = f.readline
f.close
Set f = Nothing
End If
Set fso = Nothing
End Function
Private Function Check()
Set WshShell = CreateObject("WScript.Shell")
test = WshShell.AppActivate(ReadPID())
If test = True Then
Check = 1
Else
Check = 0
End If
End Function