📄 filelist.frm
字号:
VERSION 5.00
Begin VB.Form FileList
BackColor = &H00EBF0F0&
BorderStyle = 1 'Fixed Single
Caption = "保存到"
ClientHeight = 3915
ClientLeft = 45
ClientTop = 330
ClientWidth = 4200
ControlBox = 0 'False
Icon = "FileList.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3915
ScaleWidth = 4200
StartUpPosition = 1 '所有者中心
Begin VB.CommandButton btnExit
Caption = "取消"
Height = 300
Left = 3480
TabIndex = 2
Top = 3465
Width = 645
End
Begin VB.TextBox SaveFileName
Appearance = 0 'Flat
Height = 270
Left = 720
TabIndex = 0
Top = 3480
Width = 2055
End
Begin VB.CommandButton btnSave
Caption = "保存"
Height = 300
Left = 2880
TabIndex = 1
Top = 3465
Width = 615
End
Begin VB.DriveListBox Drive1
Appearance = 0 'Flat
Height = 300
Left = 0
TabIndex = 3
Top = 0
Width = 4215
End
Begin VB.DirListBox Dir1
Appearance = 0 'Flat
Height = 1560
Left = 0
TabIndex = 4
Top = 360
Width = 4185
End
Begin VB.FileListBox File1
Appearance = 0 'Flat
Height = 1290
Left = 0
Pattern = "*.htm"
TabIndex = 5
Top = 2040
Width = 4185
End
Begin VB.Label Label1
Appearance = 0 'Flat
BackColor = &H80000005&
BackStyle = 0 'Transparent
Caption = "保存为:"
ForeColor = &H80000008&
Height = 255
Left = 45
TabIndex = 6
Top = 3540
Width = 735
End
End
Attribute VB_Name = "FileList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub btnExit_Click()
FileList.Hide
End Sub
Private Sub btnSave_Click()
If InStr(SaveFileName.Text, ":\") > 0 Then
StrFileName = SaveFileName.Text
Else
If Right(Dir1.Path, 1) = "\" Then
StrFileName = Dir1.Path & SaveFileName.Text
Else
StrFileName = Dir1.Path & "\" & SaveFileName.Text
End If
End If
Set fso = CreateObject("Scripting.FileSystemObject")
Set FileSave = fso.OpenTextFile(StrFileName, 2, True)
FieldArr = Split(Main.TxtRecordField.Text, ",")
FileSave.WriteLine ("<table border=0 CellSpacing=0 CellPadding=3 width=100% style=""font-size:9pt"">")
FileSave.WriteLine ("<tr><td nowrap><b>Site Address:</b></td><td width=100%><u>" & Main.TxtSiteAddress.Text & "</u></td></tr>")
FileSave.WriteLine ("<tr><td><b>Inject URL:</b></td><td><u>" & Main.URL.Text & "</u></td></tr>")
FileSave.WriteLine ("<tr><td><b>Time Saved:</b></td><td><u>" & Now & "</u></td></tr>")
FileSave.WriteLine ("<tr><td><b>Table Name:</b></td><td><u>" & Main.TxtRecordTable.Text & "</u></td></tr>")
FileSave.WriteLine ("</table>")
FileSave.WriteLine ("<table border=1 CellSpacing=1 CellPadding=3 width=100% bordercolor=#415A74 style=""font-size:9pt; border-collapse:collapse"">")
FileSave.Write ("<tr bgcolor=#E6F2FB>")
FileSave.Write ("<td align=center>#</td>")
For j = 0 To UBound(FieldArr) - 1
FileSave.Write ("<td><b>" & FieldArr(j) & "</b></td>")
Next
FileSave.WriteLine ("</tr>")
For i = 0 To Main.RecordList.ListCount - 1
ValueArr = Split(Main.RecordList.List(i) & "|", "|")
FileSave.Write ("<tr bgcolor=#F2F8FC>")
FileSave.Write ("<td align=center>" & i + 1 & "</td>")
For j = 0 To UBound(ValueArr) - 1
FileSave.Write ("<td>" & ValueArr(j) & "</td>")
Next
FileSave.WriteLine ("</tr>")
Next
FileSave.Write ("</table>")
Set fso = Nothing
Call MsgBox("成功导出已猜解记录至文件:" & StrFileName, 64, "NBSI提示信息")
FileList.Hide
'FileList.Hide
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive & "\"
End Sub
Private Sub File1_Click()
SaveFileName.Text = File1.FileName
End Sub
Private Sub Form_Load()
On Error Resume Next
Set fso = CreateObject("Scripting.FileSystemObject")
ExportPath = App.Path & "\Result"
If Not fso.FolderExists(ExportPath) Then fso.CreateFolder (ExportPath)
Set fso = Nothing
Dir1.Path = ExportPath
URL = Main.URL.Text
Pos_S = InStr(URL, "://") + 3
Pos_E = InStr(Pos_S, URL, "/")
SiteName = Mid(URL, Pos_S, Pos_E - Pos_S)
SaveFileName.Text = SiteName & ".htm"
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -