日语通过网页查询小工具

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

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

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

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