| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 4239 人关注过本帖
标题:求助!网页自动保存为txt的优化
只看楼主 加入收藏
hanfeng405
Rank: 1
等 级:新手上路
帖 子:1
专家分:0
注 册:2013-12-30
结帖率:0
收藏
已结贴  问题点数:20 回复次数:1 
求助!网页自动保存为txt的优化
VB初学者,请教关于将网页保存为txt的办法。
目的:生成一个exe文件,执行后不用弹出界面就能将设定的网页保存为txt文件,
比如访问http://,将网页保存为txt,命名为bj,其他地方的类似命名。

由于网址变化,以前做的用不了了,返回的结果都是404错误。帮忙的人联系不上了,由于得到的都是exe文件,没办法修改程序。
自己在网上早了一个网页保存为TXT的vb代码,里面的功能很多,还有分割文件等功能,但我用不到。
我只想按想要的文件名保存网页为txt,而且exe执行后不需弹出界面就能生成文件。网上下的这个生成exe后,运行时会有界面,虽然能打开网页,但是点击转换时提示错误424,需要对象。

我想请问各位前辈,我该如何修改原来的代码,才能实现我想要的功能,请指点一二,谢谢!还想问下,win7有合适的VB6.0吗?下了一个精简版,总是出问题。
程序代码:
Public StrHtml As String
'Download by http://www.
Private Sub cmdAddHTML_Click()
  On Error Resume Next
  With DlgFileOpen
    .CancelError = True
    .DefaultExt = "*.htm"
    .DialogTitle = "添加网页文件"
    .Filter = "网页文件(*.htm;*.html)|*.htm;*.html"
    .ShowOpen
     If Err <> 0 Then Exit Sub
     List1.Enabled = True
     cmdHTML2TXT.Enabled = True
     cmdBatConvert.Enabled = True
     cmdSavePage.Enabled = False
  End With
  List1.AddItem DlgFileOpen.FileName    '把选择的文件路径加入列表
  List1.Text = ""
End Sub
Private Sub cmdBrowse1_Click()

 On Error Resume Next

 With DlgTXTFileOpen
    .CancelError = True
    .DefaultExt = "*.txt"
    .DialogTitle = "选择文本文件"
    .Filter = "文本文件(*.txt)|*.txt"
    .ShowOpen
     If Err <> 0 Then Exit Sub
  End With
  txtSFile.Text = DlgTXTFileOpen.FileName
  lblFolder.Caption = Left(DlgTXTFileOpen.FileName, Len(DlgTXTFileOpen.FileName) - 4)
  MkDir lblFolder.Caption  '创建目标文件夹
End Sub
Private Sub cmdHTML2TXT_Click()
  Dim FileNum As Integer, i As Integer
  Dim fname As String
  If List1.Text = "" Then
    MsgBox "请先选择待转换文件!"
  Else
   '写入文本文件
   StrHtml = WebPage.Document.body.innertext
   fname = Left(List1.Text, InStr(1, List1.Text, ".") - 1)
    SaveFile fname
  End If
End Sub
Private Sub cmdBatConvert_Click()
'批量转换List1中的文件
  Dim i As Integer
  Dim fname As String
  If List1.ListCount = 0 Then
      MsgBox "请先添加网页文件!"
  Else
      For i = 1 To List1.ListCount
        BrowseIt List1.List(i - 1)
        MsgBox "成功转换第" & i & "个文件<" & List1.List(i - 1) & ">为TXT格式!"
        '提示的目的是为了使WebPage得到更新,实际上文件尚未转换
        fname = Left(List1.List(i - 1), InStr(1, List1.List(i - 1), ".") - 1)
        SaveFile fname
      Next i
  End If
End Sub
Private Sub cmdSplit_Click()
  Dim FileName As String, FileName2 As String
  Dim FileSize As Long
  Dim SplitSize As Long
  Dim FileNum As Integer, FileNum2 As Integer
  Dim FArr() As Byte
  Dim n As Integer
  Dim i As Integer
  FileNum = FreeFile
  FileName = txtSFile.Text
  Open FileName For Binary As #FileNum
  FileSize = LOF(FileNum)  '源文件大小,单位字节
  SplitSize = Val(txtSize.Text) * 1024
  ReDim FArr(1 To SplitSize) '重定义数组空间
  If FileSize <= SplitSize Then
     MsgBox "源文件小于或等于单位尺寸,无须分割!"
  Else
     n = FileSize \ SplitSize
     If n <> FileSize / SplitSize Then n = n + 1 '计算分割份数
     lblFileNum = n
     For i = 1 To n
       Get FileNum, (i - 1) * SplitSize + 1, FArr
       FileNum2 = FreeFile
       FileName2 = Right(lblFolder.Caption, InStr(StrReverse(lblFolder.Caption), "\") - 1)
       Open lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" For Binary As #FileNum2
       Put FileNum2, , FArr
       Close #FileNum2
       '加入人工判断断字功能
     If i > 1 Then
       FileNum2 = FreeFile
       Dim StrTest As String
       Dim ret As Long
       Open lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" For Input As #FileNum2
       Line Input #FileNum2, StrTest
       Close #FileNum2
       ret = MsgBox("请确认分割后文件头部文字是否正确?" & Chr(13) & StrTest, vbYesNo, "汉字断开识别")
       If ret = vbNo Then
         Get FileNum, (i - 1) * SplitSize, FArr  '不正确向前读一个
         Kill lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt"
         FileNum2 = FreeFile
         Open lblFolder.Caption & "\" & FileName2 & Trim(Str(i)) & ".txt" For Binary As #FileNum2
         Put FileNum2, , FArr
         Close #FileNum2
        End If
      End If
     
     Next i

 End If

 Close #FileNum
End Sub
Private Sub cmdViewPage_Click()
  List1.Enabled = False
  cmdHTML2TXT.Enabled = False
  cmdBatConvert.Enabled = False
  cmdSavePage.Enabled = True
  WebPage.Navigate2 txtURL.Text
  While WebPage.Busy
    DoEvents
  Wend
End Sub

Private Sub cmdSavePage_Click()
   With DlgFileSave
    .CancelError = True
    .DefaultExt = "*.txt"
    .DialogTitle = "保存为文本文件"
    .Filter = "文本文件(*.txt)|*.txt"
    .ShowSave
     If Err <> 0 Then Exit Sub
   End With
   SaveFile DlgFileSave.FileName
End Sub
Private Sub Form_Load()
  cmdSavePage.Enabled = False
End Sub
Private Sub List1_Click()
   BrowseIt List1.Text
End Sub
Private Sub SaveFile(ByRef fname As String)
    Dim FileNum As Integer
    FileNum = FreeFile
    If fname = "" Then  '规范文件名
      fname = "TXT"
    ElseIf LCase(Right(fname, 4)) <> ".txt" Then
      fname = fname & ".txt"
    End If
    StrHtml = WebPage.Document.body.innertext
    Open fname For Output As #FileNum     '保存纯文本文件,位于源html文件夹中??
    Print #FileNum, StrHtml
    Close #FileNum
End Sub
Private Sub BrowseIt(page As String)
  WebPage.Navigate page
End Sub
Private Sub txtURL_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then cmdViewPage_Click
End Sub

附网上的代码




搜索更多相关主题的帖子: 网页 而且 命名 
2013-12-30 21:28
Artless
Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19Rank: 19
等 级:贵宾
威 望:103
帖 子:4211
专家分:28888
注 册:2009-4-8
收藏
得分:20 

无知
2014-01-06 14:35
快速回复:求助!网页自动保存为txt的优化
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.026885 second(s), 8 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved