📄 frmmain.frm
字号:
VERSION 5.00
Object = "{48E59290-9880-11CF-9754-00AA00C00908}#1.0#0"; "MSINET.OCX"
Object = "{EEB6781B-CCAB-4989-B5EB-F951F77F25F1}#2.0#0"; "jcForms.ocx"
Object = "{54FC599E-9611-11D2-8350-E97AACC90D73}#1.1#0"; "SpltrBar.ocx"
Begin VB.Form frmMain
BorderStyle = 0 'None
Caption = "文章翻译小精灵"
ClientHeight = 7920
ClientLeft = 0
ClientTop = -75
ClientWidth = 11085
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7920
ScaleWidth = 11085
StartUpPosition = 2 '屏幕中心
Begin InetCtlsObjects.Inet Inet1
Left = -360
Top = 300
_ExtentX = 1005
_ExtentY = 1005
_Version = 393216
End
Begin VB.CommandButton Submit
BackColor = &H00EDE9EB&
Caption = "提 交"
BeginProperty Font
Name = "宋体"
Size = 11.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 9600
MaskColor = &H8000000F&
Style = 1 'Graphical
TabIndex = 2
Top = 7320
Width = 1095
End
Begin VB.TextBox OutInfo
Appearance = 0 'Flat
BackColor = &H00EDE9EB&
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 6015
Left = 5025
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 1
Text = "frmMain.frx":08CA
Top = 960
Width = 5535
End
Begin VB.TextBox Cookie
Appearance = 0 'Flat
Height = 6015
Left = 360
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 0
Text = "frmMain.frx":08D0
Top = 960
Width = 4575
End
Begin VB.Frame Frame2
BackColor = &H00EDE9EB&
Caption = "网站翻译服务综合利用"
Height = 6375
Left = 240
TabIndex = 5
Top = 720
Width = 10455
Begin SplitterBars.VSplitterBar VSplitterBar1
Height = 6015
Left = 4730
Top = 240
Width = 60
_ExtentX = 106
_ExtentY = 10610
BackColor = 15591915
BorderStyle = 2
End
End
Begin 工程1.jcForms jcForms1
Align = 1 'Align Top
Height = 7920
Left = 0
TabIndex = 6
Top = 0
Width = 11085
_ExtentX = 19553
_ExtentY = 13970
ThemeColor = 5
BorderStyle = 0
CloseButton = -1 'True
MaxButton = 0 'False
CustomBackColor = 15591915
Begin VB.CommandButton About
BackColor = &H00EDE9EB&
Caption = "关于(&A)"
Height = 375
Left = 2160
Style = 1 'Graphical
TabIndex = 9
Top = 7320
Width = 855
End
Begin VB.CommandButton Opt
BackColor = &H00EDE9EB&
Caption = "设置(&E)"
Height = 375
Left = 1320
Style = 1 'Graphical
TabIndex = 8
Top = 7320
Width = 855
End
Begin VB.CommandButton Del
BackColor = &H00EDE9EB&
Caption = "清空&Delete"
Height = 375
Left = 240
Style = 1 'Graphical
TabIndex = 7
Top = 7320
Width = 1095
End
Begin VB.Label Label2
AutoSize = -1 'True
BackColor = &H00EDE9EB&
Caption = "作者:黑黑子 heiheizi@gmail.com"
Height = 180
Left = 3120
TabIndex = 10
Top = 7440
Width = 2790
End
End
Begin VB.Label Label5
AutoSize = -1 'True
BackColor = &H00EDE9EB&
Caption = "搜索："
Height = 180
Left = 360
TabIndex = 4
Top = 240
Width = 585
End
Begin VB.Label Label1
AutoSize = -1 'True
BackColor = &H00EDE9EB&
Caption = "提交地址："
Height = 180
Left = 240
TabIndex = 3
Top = 2160
Width = 900
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Declare Function WideCharToMultiByte Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long, ByRef lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByVal lpUsedDefaultChar As Long) As Long
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As Long, ByVal cchMultiByte As Long, ByVal lpWideCharStr As Long, ByVal cchWideChar As Long) As Long
Private Const CP_UTF8 = 65001
Dim x As Integer
Dim y As Integer
Dim w As Integer
Dim outinfo_x As Integer
Private Sub About_Click()
frmAbout.Show
End Sub
Private Sub Del_Click()
Cookie.Text = ""
Inet1.Cancel
End Sub
Private Sub Form_Load()
'Url.Text = "http://www.excite.co.jp/world/chinese"
'Url.Text = "http://fy.iciba.com/trans.php"
Cookie.Text = ""
OutInfo.Text = ""
'frmOptions.langue(0).Item(1) = "日语=>汉语"
'frmOptions.CboUrl(1).Item(1) = "http://fy.iciba.com/trans.php"
End Sub
Private Sub Inet1_StateChanged(ByVal State As Integer)
Dim strTmp, pagecode, result, str1, str2 As String
Dim leng, n, pos1, pos2 As Integer
Dim stemp As Variant
Select Case State
Case 12
Do Until Inet1.StillExecuting = False '这里阻塞前面的Inet1，确保登陆成功之后再取页面，你可以将此Do取消了试一次。
DoEvents
Loop
stemp = Inet1.GetChunk(1024)
Do While stemp <> ""
pagecode = pagecode + stemp
stemp = Inet1.GetChunk(1024)
Loop
'Dim numFile As Integer
'numFile = FreeFile()
'Open App.Path + "\test.dat" For Binary Access Read Write As #numFile
'Put #numFile, 1, pagecode
'Close #numFile
'pagecode = ReadTextFromUTF8(App.Path + "\test.dat")
'numFile = FreeFile()
'Open App.Path + "\after.dat" For Binary Access Read Write As #numFile
'Put #numFile, 1, pagecode
'Close #numFile
'MsgBox uByt
'Form2.Show
'Form2.prScreen (pagecode)
'Form2.Text1.Text = pagecode
'pagecode = UTFDecode(App.Path + "\test.dat", "utf-8", "gb2312")
'strTmp = pagecode
str1 = "<div id=""t"">"
str2 = "</div>"
Dim str1_len As Integer
str1_len = Len(str1)
pos1 = InStr(1, pagecode, str1)
pagecode = Right(pagecode, Len(pagecode) - pos1 - str1_len + 1)
pos2 = InStr(1, pagecode, str2)
pagecode = Left(pagecode, pos2 - 1)
If (pagecode = "" Or pagecode = "Object") Then
Dim strFormdata As String
strFormdata = "content=" + Cookie.Text + "&TransType=" + GetSetting(App.Title, "opt", "lang")
Inet1.Execute GetSetting(App.Title, "opt", "strUrl"), "Post", strFormdata, "Content-Type: application/x-www-form-urlencoded "
Else
pagecode = Replace(pagecode, "<br />", "")
OutInfo.Text = "翻译结果:" + pagecode
Submit.Enabled = True
End If
Case Else
End Select
End Sub
Function UTFDecode(filePathName As String, writeCode As String, readCode As String) As String
'Dim adoSd As ADODB.Stream
'Set adoSd = New ADODB.Stream
'adoSd.Mode = adModeRecursive
'adoSd.Type = adTypeText
'adoSd.Open
'adoSd.Charset = writeCode 'UTF-8
'adoSd.LoadFromFile filePathName
'adoSd.Position = 0
'adoSd.Charset = readCode 'gb2312
'UTFDecode = adoSd.ReadText
'adoSd.Close
'Set adoSd = Nothing
End Function
Function ReadTextFromUTF8(ByVal sFile As String) As String
Dim uByt() As Byte
Dim fLen As Long
Dim fh As Integer
fh = FreeFile()
Open sFile For Binary As #fh
fLen = LOF(fh)
If fLen > 2 Then '处理 utf8 的 bom 头
ReDim uByt(2) '读取文件前3个字节，判断是否 utf8 bom 标记
Get #fh, , uByt
If uByt(0) = &HEF And uByt(1) = &HBB And uByt(2) = &HBF Then
'如果有 bom ，需要从第4个字节开始读取
ReDim uByt(fLen - 4)
Else
Seek #fh, 1
ReDim uByt(fLen - 1)
End If
Else
ReDim uByt(fLen - 1)
End If
Get #fh, , uByt
Close #fh
ReadTextFromUTF8 = UTF8_Decode(uByt)
Erase uByt
End Function
Private Function UTF8_Encode(ByVal strUnicode As String) As Byte()
'UTF-8 编码
Dim TLen As Long
Dim lngBufferSize As Long
Dim lngResult As Long
Dim bytUtf8() As Byte
TLen = Len(strUnicode)
If TLen = 0 Then Exit Function
lngBufferSize = TLen * 3 + 1
ReDim bytUtf8(lngBufferSize - 1)
lngResult = WideCharToMultiByte(CP_UTF8, 0, StrPtr(strUnicode), TLen, bytUtf8(0), lngBufferSize, vbNullString, 0)
If lngResult <> 0 Then
lngResult = lngResult - 1
ReDim Preserve bytUtf8(lngResult)
End If
UTF8_Encode = bytUtf8
End Function
Private Function UTF8_Decode(ByRef bUTF8() As Byte) As String
'UTF-8 解码
Dim lRet As Long
Dim lLen As Long
Dim lBufferSize As Long
Dim sBuffer As String
lLen = UBound(bUTF8) + 1
If lLen = 0 Then Exit Function
lBufferSize = lLen * 2
sBuffer = String$(lBufferSize, Chr(0))
lRet = MultiByteToWideChar(CP_UTF8, 0, VarPtr(bUTF8(0)), lLen, StrPtr(sBuffer), lBufferSize)
If lRet <> 0 Then
sBuffer = Left(sBuffer, lRet)
End If
UTF8_Decode = sBuffer
End Function
Private Sub Quit_Click()
End
End Sub
Private Sub langue_Click(Index As Integer)
'MsgBox langue.Item(Index)
End Sub
Private Sub mnuOption_Click()
frmOptions.Show
End Sub
Private Sub Opt_Click()
frmOptions.Show
End Sub
Private Sub Submit_Click()
Dim strTmp, result, str1, str2, langue As String
Dim leng, i, n, pos1, pos2 As Integer
Dim strUrl As String
Dim strWebName As String
Dim lang As String
Dim strFormdata As String
Dim stemp As Variant
Dim pagecode As String
Submit.Enabled = False
strUrl = GetSetting(App.Title, "opt", "strUrl")
strWebName = GetSetting(App.Title, "opt", "strWebName")
lang = GetSetting(App.Title, "opt", "lang")
OutInfo.Text = ""
strFormdata = "content=" + Cookie.Text + "&TransType=" + lang
If InStr(1, strUrl, "http://") = 0 Or Left(strUrl, 7) <> "http://" Then
MsgBox ("请输入正确的地址")
Submit.Enabled = True
Exit Sub
End If
Inet1.Execute strUrl, "Post", strFormdata, "Content-Type: application/x-www-form-urlencoded "
End Sub
Private Sub VSplitterBar1_EndMoving()
Dim moveX As Integer
Dim moveY As Integer
moveX = VSplitterBar1.Left
moveY = VSplitterBar1.Top
If (moveX > Cookie.Left And moveX < outinfo_x) Then
moveX = VSplitterBar1.Left - x
moveY = VSplitterBar1.Top - y
If (w - moveX > 0 And Cookie.Width + moveX > 0) Then
Cookie.Width = Cookie.Width + moveX
OutInfo.Left = OutInfo.Left + moveX
OutInfo.Width = w - moveX
End If
Else
VSplitterBar1.Left = x
VSplitterBar1.Top = y
End If
End Sub
Private Sub VSplitterBar1_StartMoving()
x = VSplitterBar1.Left
y = VSplitterBar1.Top
w = OutInfo.Width
outinfo_x = OutInfo.Width + OutInfo.Left
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -