日语通过网页查询小工具

JP2CH.vbp

Type=Exe Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\..\WINDOWS\system32\stdole2.tlb#OLE Automation Object={EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0; shdocvw.dll Reference=*\G{00000205-0000-0010-8000-00AA006D2EA4}#2.5#0#..\..\..\..\Program Files\Common Files\system\ado\msado25.tlb#Microsoft ActiveX Data Objects 2.5 Library Object={3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0; RICHTX32.OCX Form=frmMain.frm Module=modPub; modPub.bas Module=modIni; modIni.bas IconForm="frmMain" Startup="Sub Main" HelpFile="" Title="JP2CH" ExeName32="JP2CH.exe" Command32="" Name="JP2CH" HelpContextID="0" CompatibleMode="0" MajorVer=1 MinorVer=0 RevisionVer=0 AutoIncrementVer=0 ServerSupportFiles=0 VersionCompanyName="fnst" CompilationType=0 OptimizationType=0 FavorPentiumPro(tm)=0 CodeViewDebugInfo=0 NoAliasing=0 BoundsCheck=0 OverflowCheck=0 FlPointCheck=0 FDIVCheck=0 UnroundedFP=0 StartMode=0 Unattended=0 Retained=0 ThreadPerObject=0 MaxNumberOfThreads=1

frmMain.frm

VERSION 5.00 Object = "{EAB22AC0-30C1-11CF-A7EB-0000C05BAE0B}#1.1#0"; "shdocvw.dll" Object = "{3B7C8863-D78F-101B-B9B5-04021C009402}#1.2#0"; "richtx32.ocx" Begin VB.Form frmMain Caption = "JP2CH" ClientHeight = 8145 ClientLeft = 60 ClientTop = 630 ClientWidth = 13230 Icon = "frmMain.frx":0000 LinkTopic = "Form1" ScaleHeight = 8145 ScaleWidth = 13230 Begin VB.PictureBox Picture1 BorderStyle = 0 'None Height = 495 Left = 0 ScaleHeight = 495 ScaleWidth = 10695 TabIndex = 6 Top = 0 Width = 10695 Begin VB.CommandButton cmdSearch Caption = "&Search" Height = 330 Left = 4320 TabIndex = 1 Top = 45 Width = 1215 End Begin RichTextLib.RichTextBox txtWord Height = 330 Left = 45 TabIndex = 0 Top = 45 Width = 4215 _ExtentX = 7435 _ExtentY = 582 _Version = 393217 Enabled = -1 'True MultiLine = 0 'False AutoVerbMenu = -1 'True TextRTF = $"frmMain.frx":08CA End Begin VB.CommandButton toolbar Appearance = 0 'Flat Enabled = 0 'False Height = 425 Left = 0 TabIndex = 7 Top = 0 Width = 9735 End End Begin VB.PictureBox Picture2 Appearance = 0 'Flat BackColor = &H80000005& BorderStyle = 0 'None ForeColor = &H80000008& Height = 3735 Left = 10920 ScaleHeight = 3735 ScaleWidth = 2175 TabIndex = 3 Top = 480 Width = 2175 Begin VB.Label Label2 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "http://www.symental.com" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 195 Left = 360 TabIndex = 5 Top = 2040 Width = 2175 End Begin VB.Label Label1 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "Welcome to JP2CH !" BeginProperty Font Name = "MS Sans Serif" Size = 13.5 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 360 Left = 240 TabIndex = 4 Top = 1440 Width = 2895 End End Begin SHDocVwCtl.WebBrowser WebBrowser1 Height = 5895 Left = 0 TabIndex = 2 Top = 480 Width = 10575 ExtentX = 18653 ExtentY = 10398 ViewMode = 0 Offline = 0 Silent = 0 RegisterAsBrowser= 0 RegisterAsDropTarget= 1 AutoArrange = 0 'False NoClientEdge = 0 'False AlignLeft = 0 'False NoWebView = 0 'False HideFileNames = 0 'False SingleClick = 0 'False SingleSelection = 0 'False NoFolders = 0 'False Transparent = 0 'False ViewID = "{0057D0E0-3573-11CF-AE69-08002B2E1262}" Location = "http:///" End Begin VB.Label lblStatus BorderStyle = 1 'Fixed Single Height = 255 Left = 0 TabIndex = 8 Top = 7855 Width = 6495 End Begin VB.Menu mnuFile Caption = "&File" Begin VB.Menu mnuFileExit Caption = "&Exit" Shortcut = ^Q End End Begin VB.Menu mnuMode Caption = "&Mode" Begin VB.Menu mnuModeSet Caption = "JP->&CH" Checked = -1 'True Index = 0 Shortcut = {F1} End Begin VB.Menu mnuModeSet Caption = "CH->&JP" Index = 1 Shortcut = {F2} End Begin VB.Menu mnuModeSet Caption = "CH->&EN" Index = 2 Shortcut = {F3} End End Begin VB.Menu mnuHelp Caption = "&Help" Begin VB.Menu mnuHelpAbout Caption = "&About" Shortcut = ^H End End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Dim isHidePic As Boolean Private Declare Function SetCursor Lib "user32" (ByVal hCursor As Long) As Long Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Sub Form_Load() Call setMnuMode(intMode) Me.Move lngLeft, lngTop, lngWidth, lngHeight If isMax Then Me.WindowState = 2 End If End Sub Private Sub Form_Resize() On Error GoTo err1 lblStatus.Width = Me.ScaleWidth lblStatus.Top = Me.ScaleHeight - lblStatus.Height Picture1.Width = Me.ScaleWidth WebBrowser1.Move 0, WebBrowser1.Top, Me.ScaleWidth, Me.ScaleHeight - lblStatus.Height - Picture1.Height - 20 If Not isHidePic Then Picture2.Move 0, WebBrowser1.Top, WebBrowser1.Width, WebBrowser1.Height err1: End Sub Private Sub Form_Unload(Cancel As Integer) isMax = (Me.WindowState = 2) If Me.WindowState = 0 Then lngLeft = Me.Left lngTop = Me.Top lngWidth = Me.Width lngHeight = Me.Height End If Call saveToIniFile End Sub Private Sub cmdSearch_Click() If Trim(txtWord.Text) = "" Then Exit Sub lblStatus.Caption = "Searching ..." Select Case intMode Case eJP2CH WebBrowser1.Navigate "http://dict.hjenglish.com/jp/m/?w=" & EncodeUTF8(txtWord.Text) & "&type=jc" Case eCH2JP WebBrowser1.Navigate "http://dict.hjenglish.com/jp/m/?w=" & EncodeUTF8(txtWord.Text) & "&type=cj" Case eCH2EN WebBrowser1.Navigate "http://dict.hjenglish.com/m/?w=" & EncodeUTF8(txtWord.Text) End Select End Sub Private Sub Label2_Click() ShellExecute hwnd, "open", "http://www.symental.com", "", "", 1 End Sub Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) If Button = 0 Then SetCursor 45 End Sub Private Sub mnuFileExit_Click() Unload Me End Sub Private Sub mnuHelpAbout_Click() MsgBox "JP2CH 1.0" & vbCrLf & vbCrLf & _ "Author: sysdzw" & vbCrLf & _ "Email: sysdzw@163.com" & vbCrLf & _ "Home: http://www.symental.com" & vbCrLf & vbCrLf & _ "2009/4/24", vbInformation End Sub Private Sub mnuModeSet_Click(Index As Integer) intMode = Index Call setMnuMode(Index) End Sub Private Sub Picture1_Resize() On Error GoTo err1 ToolBar.Width = Picture1.Width txtWord.Width = Me.ScaleWidth - cmdSearch.Width - 160 cmdSearch.Left = Me.ScaleWidth - cmdSearch.Width - 75 err1: End Sub Private Sub setMnuMode(ByVal intMode As Integer) mnuModeSet(0).Checked = False mnuModeSet(1).Checked = False mnuModeSet(2).Checked = False mnuModeSet(intMode).Checked = True End Sub Private Sub Picture2_Resize() Label1.Move (Picture2.Width - Label1.Width) / 2, (Picture2.Height - Label1.Height) / 2 Label2.Move (Picture2.Width - Label2.Width) / 2, Label1.Top + Label1.Height + 100 End Sub Private Sub txtWord_KeyPress(KeyAscii As Integer) If KeyAscii = 13 Then Call cmdSearch_Click End Sub Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant) If InStr(URL, "http://dict.hjenglish.com") > 0 Then lblStatus.Caption = "Complete" isHidePic = True Picture2.Visible = False Dim i% i = WebBrowser1.Document.All.Tags("div").length WebBrowser1.Document.All.Tags("div")(0).innerhtml = "Suggest or report bug to author: <a href=""mailto:jy_dzw@cn.fujitsu.com"">jy_dzw@cn.fujitsu.com</a> version:" & App.Major & "." & App.Minor & "." & App.Revision WebBrowser1.Document.All.Tags("div")(i - 1).innerhtml = "" If intMode <> eCH2EN Then WebBrowser1.Document.All.Tags("div")(i - 2).innerhtml = "" Else ' WebBrowser1.Document.getElementsById("f1")(0).Hide ' WebBrowser1.Document.parentWindow.execScript "f1.Hide" ' WebBrowser1.Document.parentWindow.execScript "Document.getElementsById(""f1"")(0).Hide" End If ' WebBrowser1.Document.All.Tags("hr")(0).Width = "0" WebBrowser1.Document.All.Tags("hr")(1).Width = "0" End If End Sub

modPub.bas

 Attribute VB_Name = "modPub" Option Explicit Public strAppPath$ Public intMode As Integer Public isMax As Boolean Public lngLeft&, lngTop&, lngWidth&, lngHeight& Enum WordType eJP2CH eCH2JP eCH2EN End Enum Sub Main() strAppPath = App.Path If Right(strAppPath, 1) <> "\" Then strAppPath = strAppPath & "\" iniFileName = strAppPath & "SET.INI" If Dir(iniFileName) <> "" Then Call initFromIniFile Else Call initFromApp Call saveToIniFile End If frmMain.Show End Sub 'ｴﾓﾅ葷ﾃﾎﾄｼｳｼｻｯ Private Sub initFromIniFile() On Error GoTo err1 intMode = Val(Trim(GetIniS("Main", "Mode"))) If intMode < 0 Or intMode > 2 Then GoTo err1 lngLeft = Val(Trim(GetIniS("FormPos", "Left"))) lngTop = Val(Trim(GetIniS("FormPos", "Top"))) lngLeft = Val(Trim(GetIniS("FormPos", "Left"))) lngWidth = Val(Trim(GetIniS("FormPos", "Width"))) lngHeight = Val(Trim(GetIniS("FormPos", "Height"))) isMax = CBool(Trim(GetIniS("FormPos", "IsMax"))) Exit Sub err1: Call initFromApp Call saveToIniFile End Sub 'ｱ｣ｴ豬ｽﾅ葷ﾃﾎﾄｼ Public Sub saveToIniFile() SetIniS "Main", "Mode", CStr(intMode) SetIniS "FormPos", "Left", CStr(lngLeft) SetIniS "FormPos", "Top", CStr(lngTop) SetIniS "FormPos", "Width", CStr(lngWidth) SetIniS "FormPos", "Height", CStr(lngHeight) SetIniS "FormPos", "IsMax", CStr(isMax) End Sub 'ﾓﾃｳﾌﾐﾔﾉ昕ｼｻｯ Private Sub initFromApp() isMax = True intMode = 1 lngLeft = (Screen.Width - 13350) / 2 lngTop = (Screen.Height - 8853) / 2 lngWidth = 13350 lngHeight = 8853 End Sub Public Function EncodeUTF8(ByVal Text) As String Dim oStream As ADODB.Stream Dim aUTF8() As Byte Dim sUTF8 As String Dim i As Long Set oStream = New ADODB.Stream oStream.Open oStream.Charset = "UTF-8" oStream.Type = adTypeText oStream.WriteText Text oStream.Position = 0 oStream.Type = adTypeBinary aUTF8 = oStream.Read() oStream.Close For i = 3 To UBound(aUTF8) sUTF8 = sUTF8 & "%" & Right$("0" & Hex(aUTF8(i)), 2) Next EncodeUTF8 = sUTF8 End Function

modIni.bas

Attribute VB_Name = "modIni" Option Explicit Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long Public iniFileName As String Function GetIniS(ByVal SectionName As String, ByVal KeyWord As String, Optional ByVal DefString As String) As String Dim ResultString As String * 144, Temp% Dim s$, i% Temp% = GetPrivateProfileString(SectionName, KeyWord, "", ResultString, 144, iniFileName) If Temp% > 0 Then For i = 1 To 144 If Asc(Mid$(ResultString, i, 1)) <> 0 Then s = s & Mid$(ResultString, i, 1) End If Next Else Temp% = WritePrivateProfileString(SectionName, KeyWord, DefString, iniFileName) s = DefString End If GetIniS = s End Function Public Function SetIniS(ByVal SectionName As String, ByVal KeyWord As String, ByVal ValStr As String) As Boolean SetIniS = WritePrivateProfileString(SectionName, KeyWord, ValStr, iniFileName) End Function Public Function DelIniSec(ByVal SectionName As String) As Boolean DelIniSec = WritePrivateProfileString(SectionName, 0&, "", iniFileName) End Function 'delKeyWord Public Function DelIniKey(ByVal SectionName As String, ByVal KeyWord As String) As Boolean DelIniKey = WritePrivateProfileString(SectionName, KeyWord, 0&, iniFileName) End Function