分類目錄歸檔:VB程序

VB設置WebBrowser1的IE版本

VB內嵌網頁,好像只有 WebBrowser 控件 嵌入。開發過程中遇到一個非常變態的問題,無論目標主機 安裝的什么IE版本,都是按IE7的模式顯示。現在很多網站已經不支持IE7了,這個問題非常蛋疼。

翻閱了很多資料,最終在 Stack Overflow(http://stackoverflow.com/questions/14974502/c-sharp-internet-explorer-9-and-axwebbrowser)找到了解決方法。不僅能解決VB的WebBrowser1的IE版本控制。還能解決C#的IE版本控制,VB.Net的IE版本控制。操作非常簡單 繼續閱讀

VB+HTML實現Win8界面

天天和WEB打交道,忽然需要寫個客戶端,就傻眼了把。沒有CSS,沒有JQuery,還寫個毛。調用默認額度控件,又丑死了,而且非常不靈活。如果把HTML和VB結合起來,做客戶端界面就爽多了。

實在郁悶,在網上偶爾找到了HyperApp.cls,好東西啊,在他的基礎上我擴展了些,寫出來了一個演示程序。

繼續閱讀

ASP文本存儲方案-FileDB

四月份做個一個短信系統,當時為了節省成本(使用萬網的空間,不帶SQL數據庫空間便宜),使用了ASP+Access開發,最近需要升級,增加一個短信接口。發現現在Access的數據庫竟然有170MB。我的天啊,因為查詢比較少,不是很耗資源,所以沒有檢查出來。
僅僅六個月,數據庫竟然到了170MB。隨著客戶業務的增長,可能再過六個月就要到500MB了,真恐怖。主要占空間大小的,就是存儲的短信的發送號碼,思考再三,決定將所有的保存到文本文件中。于是寫下了一個暫時成為FileDB的asp類。

Class FileDB
  Dim fso,IdxKey,DBPath
  Private Sub Class_Initialize
    Set fso = Server.CreateObject("Scripting.FileSystemObject")
    idxKey = "demo::test"
    DBPath = "DataCenter/File_DB/"
  End Sub

  Private Function getPath()
    Dim tmp
    getPath = replace(idxKey,"::","/") & ".html"
  End Function

  Private Function checkFile(byref fname)
    fname = Server.Mappath(DBPath & getPath())
    checkFile = fso.fileexists(fname)
  End Function

  Private Sub createPathName(byval idxKey)
    Dim TmpPa
    TmpPa = Server.Mappath(DBPath & idxKey)
    if not fso.folderexists(TmpPa) then
      if instr(idxKey,"\") > 0 then Call createPathName(left(idxKey,instrrev(idxKey,"\")-1))
      fso.createfolder(TmpPa)
    end if
  End Sub

  Public Function getTxt()
    if checkFile(fname) then
      set Txt = fso.getfile(fname)
      if Txt.size = 0 then
        Tmp = ""
      else
        Tmp = fso.opentextfile(fname).readall
      end if
      set Txt = Nothing
      getTxt = Tmp
    else
      getTxt = ""
    end if
  End Function

  Public Function remove()
    if checkFile(fname) then
      fso.deletefile fname
    end if
  End Function

  Public Function Save(byval content)
    if checkFile(fname) then
      set fpo = fso.opentextfile(fname,2)
    else
      idxKey = replace(idxKey,"::","\")
      if instr(idxKey,"\")>0 then Call createPathName(left(idxKey,instrrev(idxKey,"\")-1))
      set fpo = fso.createtextfile(fname)
    end if
    fpo.write content
    fpo.close
    set fpo = nothing
  End Function
End Class

因為時間比較緊,而且代碼比較簡單,就不加注釋了,實際就是簡化了文本文件的操作方法。

<% Server.ScriptTimeOut=10000 %> 
<%
  '數據庫鏈接代碼
  
  set fdb = new FileDB
  fdb.DBPath = "../DataCenter/sms_DB/"
    
  conn.open constr
  set rs = server.createobject("ADODB.Recordset")
  '得到所有沒有轉換的數據
  rs.open "select * from sendlog where send_mob not like '%::%'",conn,3,2
  do while not rs.eof
    'FileDB 數據存放路徑,日期::MD5(ID)
    idxStr = split(Rs("send_date")," ")(0) & "::" & md5(Rs("send_id"))
    fdb.IdxKey = idxStr
    fdb.Save(Rs("send_mob"))
    Rs("send_mob") = idxStr
    rs.update
    rs.movenext
  loop
  rs.close
  conn.close
  
  '數據庫壓縮過程,不是重點,再次不再多述
  compactdata(DataPath)
%>
減肥成功,所有數據轉存到FileDB中。

執行一下,所有數據就轉存好了,讀取的時候很簡單,指定了 idxStr,用getTxt()即可得到內容。

  set fdb = new FileDB
  fdb.DBPath = "../DataCenter/sms_DB/"
  '../DataCenter/sms_DB/aaa/1111.txt
  fdb.idxKey = "aaa::1111"
  str1 = fdb.getTxt()
  '../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt
  fdb.idxKey = "bbb:ccc::ddd:eee"
  str2 = fdb.getTxt()
  '刪除 ../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt
  fdb.remove() 
  '因為文件不存在,得到的值就是空字符串
  str3 = fdb.getTxt()
  '將內容保存到../DataCenter/sms_DB/bbb/ccc/ddd/eee.txt,因為不存在則創建,如果存在,則修改。
  fdb.save("11111")

2010年10月24日更新小Bug,修復了idxKey 定于數據存放在根目錄,就會報錯的錯誤

pushWeb 小更新

以前寫過一篇PushWeb 采集站點信息發布的最佳方案(http://www.yslfodr.com/p/pushweb),用了很久,現在數據量大了,導入速度很慢(主要原因是導入一條記錄,自動修復一次數據),在此,我修改了一下代碼,暫且算是升級到1.01吧:

'pushWeb 1.01

'刷新時間
const pushWeb_flush_Time=600000
'數據庫路徑
const pushWeb_dbPath="D:\WebDesign\Products\pushWeb\DB\PushWebDB.mdb"


function pushWeb()
	on error resume next
	dim conn,rs,push_id,push_webid,push_sql
	dim web_db,web_name
	dim push_Arr,push_str
	
	set conn=createobject("ADODB.connection")
	conn.open "provider=microsoft.jet.oledb.4.0;data source="&pushWeb_dbPath
	set rs=conn.execute("select push_webid from push")
	if rs.eof then
		push_id=0
		wscript.echo "沒有更新,"&pushWeb_flush_Time/1000&"秒后再檢查..."
	else
		push_webid=rs(0)
	end if
	rs.close
	set rs=nothing
	
	if push_webid<>0 then
		'載入站點信息
		set rs=conn.execute("select web_name,web_db from web where web_id="&push_webid)
		if not rs.eof then
			web_name=rs(0)
			web_db=rs(1)
		else
			wscript.echo "錯誤的任務請求,"&pushWeb_flush_Time/1000&"秒后再檢查..."
			exit function
		end if
		rs.close
		set rs=nothing
		
		'如果是合法的站點
		if web_db<>"" and web_name<>"" then
			wscript.echo "找到一個任務[站點名="&web_name&"],導入中..."
			'創建新的連接對象
			set newConn=CreateObject("ADODB.Connection")
			newConn.open web_db
			
			set rs=conn.execute("select push_sql from push where push_webid="&push_webid)
			
			do while not rs.eof
				push_sql=rs(0)
				push_Arr=split(push_sql,vbCrlf)
				for each push_str in push_Arr
					wscript.echo "插入一條數據..."
					if trim(push_str)<>"" then newConn.execute(trim(push_str))
				next
				rs.movenext
			loop

			'清空該站點下的所有任務
			conn.execute("delete from push where push_webid="&push_webid)

			wscript.sleep 100
			wscript.echo "開始修復數據..."
			'修復數據
			set repairRs=createobject("ADODB.recordset")
			repairRs.open "select * from NC_softList",newConn,3,2
			do while not repairRs.eof
				if not isnull(repairRs("Content")) then repairRs("Content")=replace(replace(repairRs("Content"),"{’}","'"),"{\n}",vbCrlf)
				repairRs.update
				repairRs.movenext
			loop
			repairRs.close
			set repairRs=nothing
			wscript.sleep 100
		end if
	else
		wscript.sleep pushWeb_flush_Time
	end if
	wscript.echo string(60,"=")
	call pushWeb()
end function


wscript.echo string(60,"=")
wscript.echo "pushWeb version:1.01"
wscript.echo "pushWeb Design:苗啟源"
wscript.echo "pushWeb Home:miaoqiyuan.cn"
wscript.echo string(60,"=")
wscript.echo "pushWeb Starting..."
wscript.echo string(60,"=")
call pushWeb()

CMDPad 批處理輔助工具

CMDPad 批處理輔助工具

cmdpad-1

通過YQYStudio助手功能,即使不懂批處理命令,僅需點幾下鼠標,也可以寫出功能強大的批處理工具。
cmdpad-2

復雜的邏輯命令,點擊即可獲得簡單的使用說明。
cmdpad-3

可以通過菜單或者快捷鍵(Ctrl+E)關閉源奇緣助手,通過(Ctrl+Y)開啟源奇緣助手
cmdpad-41

可以通過菜單修改背景顏色,字體顏色,字體大小,文字字體。
cmdpad-5

通過批處理輔助(Alt+C)即可打開批處理輔助菜單,可以通過簡單的選擇菜單,即可生成相應的批處理命令。
cmdpad-6

下載CMDPad 批處理輔助工具

CMDPad 批處理輔助工具文檔

CMDPad 批處理輔助工具源碼

TENCENT協議的實現原理-通過自定義協議執行程序

通過Tencent://Message/可以打開QQ和朋友聊天,一直對他挺好奇?到底是什么原理?
今天,我在網上找了一下TENCENT協議的實現原理,還真找到了;文章請訪問:http://hi.baidu.com/kmiaoer/blog/item/799fd388ec403691a5c2723b.html
原來是在注冊表中修改的。
知道了原理就好辦了,我們也來寫一個

定義一個miaoqiyuan協議。實現什么功能的,哦,多了,miaoqiyuan:你好。這樣來實現彈出對話框,彈出你好。

Windows Registry Editor Version 5.00
 
[HKEY_CLASSES_ROOT\miaoqiyuan]
@="miaoqiyuan Protocol"
"URL Protocol"="D:\\miaoqiyuan\\miaoqiyuan.exe"
 
[HKEY_CLASSES_ROOT\Smiaoqiyuan\DefaultIcon]
@="D:\\miaoqiyuan\\miaoqiyuan.exe,0"
 
[HKEY_CLASSES_ROOT\miaoqiyuan\shell]
 
[HKEY_CLASSES_ROOT\miaoqiyuan\shell\open]
 
[HKEY_CLASSES_ROOT\miaoqiyuan\shell\open\command]
@=\"D:\\miaoqiyuan\\miaoqiyuan.exe\" %1"

這樣,通過miaoqiyuan:鏈接的文件都可以通過miaoqiyuan.exe打開了

下面說說怎樣來彈出對話框。

在VB中新建一個標準的EXE程序,新建一個按鈕,改名為Showmsg,雙擊,輸入END(點擊退出程序)

然后添加

Private Sub Form_Load()
    showmsg.Caption = Replace(Command(), "miaoqiyuan:", "")
End Sub

這樣就可以通過輸入miaoqiyuan:1234彈出1234的警告了

這樣就可用通過一個自定義的協議來執行程序了