实例介绍
【实例简介】
【实例截图】
【核心代码】
VERSION 5.00
Begin VB.Form Form1
BorderStyle = 1 'Fixed Single
Caption = "新版Post协议头整理工具"
ClientHeight = 7575
ClientLeft = 45
ClientTop = 435
ClientWidth = 15240
Icon = "Form1.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 7575
ScaleWidth = 15240
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command3
Caption = "vb.6.0 WinHttp"
Height = 375
Left = 2400
TabIndex = 7
Top = 3360
Width = 2175
End
Begin VB.CommandButton Command2
Caption = "vb.net"
Height = 375
Left = 1560
TabIndex = 6
Top = 7080
Width = 2175
End
Begin VB.Timer Timer1
Interval = 200
Left = 7320
Top = 3360
End
Begin VB.CommandButton Command4
Caption = "vb.6.0"
Height = 375
Left = 120
TabIndex = 5
Top = 7080
Width = 1335
End
Begin VB.Frame Frame2
Caption = "协议头参数提取"
Height = 3135
Left = 120
TabIndex = 3
Top = 3840
Width = 15015
Begin VB.TextBox Text2
Height = 2775
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 4
Top = 240
Width = 14775
End
End
Begin VB.Frame Frame1
Caption = "协议头整理区"
Height = 3135
Left = 120
TabIndex = 1
Top = 120
Width = 15015
Begin VB.TextBox Text1
Height = 2775
Left = 120
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Top = 240
Width = 14775
End
End
Begin VB.CommandButton Command1
Caption = "vb.net HttpWebRequest"
Height = 375
Left = 120
TabIndex = 0
Top = 3360
Width = 2175
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Long
Private Declare Function SkinH_SetAero Lib "SkinH.dll" (ByVal hwnd As Long) As Long
Private Declare Function SkinH_Attach Lib "SkinH.dll" () As Long
Private Declare Function SkinH_AttachEx Lib "SkinH.dll" (ByVal lpSkinFile As String, ByVal lpPasswd As String) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Sub Command2_Click()
Dim a
Dim b As String
Dim c As String
Dim i As Integer
Dim e As String
a = Split(Text2.Text, vbCrLf)
For i = LBound(a) To UBound(a)
If Trim(a(i)) <> "" Then '排除空行
If InStr(Trim(a(i)), ": ") > 0 Then '判断是否符合处理条件
If InStr(Trim(a(i)), ": ") > 0 And InStr(Trim(a(i)), "=") > 0 Then
e = e & "Dim " & Split(Split(Trim(a(i)), ": ")(1), "=")(0) & " As String" & vbCrLf
If InStr(Trim(a(i)), ";") > 0 Then
b = b & Split(Split(Trim(a(i)), ": ")(1), "=")(0) & " = " & "Split(Split(TextBox2.Text, " & Chr(34) & Split(Split(Trim(a(i)), ": ")(1), "=")(0) & "=" & Chr(34) & ")(1), " & Chr(34) & ";" & Chr(34) & ")(0)" & vbCrLf
End If
End If
End If
End If
Next
Text2.Text = e & vbCrLf & b
On Error Resume Next
Clipboard.Clear
Clipboard.SetText Text2.Text
MsgBox "代码已复制成功！", vbOKOnly, "提示"
End Sub
Private Sub Command3_Click()
Dim a
Dim b As String
Dim c As String
Dim i As Integer
a = Split(Text1.Text, vbCrLf)
For i = LBound(a) To UBound(a)
If Trim(a(i)) <> "" Then '排除空行
If InStr(Trim(a(i)), ": ") > 0 Then '判断是否符合处理条件
If Left(Trim(a(i)), 26) <> "WinHttp.SetRequestHeader " & Chr(34) Then '排除已被处理行
If Left(Trim(a(i)), 16) = "Content-Length: " Then '判断是否为post
b = b & "WinHttp.SetRequestHeader " & Chr(34) & "Content-Length" & Chr(34) & ", Len(ShuJu)" & vbCrLf
Else
c = Replace(Trim(a(i)), ": ", Chr(34) & "," & Chr(34))
b = b & "WinHttp.SetRequestHeader " & Chr(34) & c & Chr(34) & vbCrLf
End If
Else
b = b & Trim(a(i)) & vbCrLf
End If
Else
b = b & Trim(a(i)) & vbCrLf
End If
End If
Next
Text1.Text = b
On Error Resume Next
Clipboard.Clear
Clipboard.SetText Text1.Text
MsgBox "代码已复制成功！", vbOKOnly, "提示"
End Sub
Private Sub Form_Load()
SkinH_Attach
End Sub
Private Sub Timer1_Timer()
If GetAsyncKeyState(vbKeyF2) Then
If GetForegroundWindow = Me.hwnd Then
Dim a As Object
Set a = CreateObject("WScript.shell")
a.SendKeys Chr(34) & " & " & "^v" & " & " & Chr(34)
End If
End If
End Sub
Private Sub Command1_Click()
Dim a() As String
Dim b As String
Dim c As Integer
Dim d As String
a = Split(删除所有空行(Text1.Text), vbCrLf)
For c = LBound(a) To UBound(a)
Dim qian As String
Dim hou As String
If Trim(a(c)) <> "" Then '排除空行
qian = "httpQonse." & Replace(Split(Trim(a(c)), ": ")(0), "-", "")
hou = Chr(34) & Split(Trim(a(c)), ": ")(1) & Chr(34)
If InStr(qian, "httpQonse.AcceptEncoding") < 1 And InStr(qian, "httpQonse.AcceptLanguage") < 1 And InStr(qian, "httpQonse.Connection") < 1 And InStr(qian, "httpQonse.Origin") < 1 And InStr(qian, "httpQonse.XRequestedWith") < 1 Then
If InStr(qian, "httpQonse.ContentLength") > 0 Then
d = d & "httpQonse.ContentLength = postByte.Length" & vbCrLf
Else
If InStr(qian, "httpQonse.Cookie") > 0 Then
qian = "httpQonse.Headers.Set(" & Chr(34) & "Cookie" & Chr(34) & ", "
d = d & qian & hou & ")" & vbCrLf
Else
d = d & qian & " = " & hou & vbCrLf
End If
End If
End If
End If
Next c
Text1.Text = d
On Error Resume Next
Clipboard.Clear
Clipboard.SetText Text1.Text
MsgBox "代码已复制成功！", vbOKOnly, "提示"
End Sub
Private Sub Command4_Click()
Dim a
Dim b As String
Dim c As String
Dim i As Integer
Dim e As String
a = Split(Text2.Text, vbCrLf)
For i = LBound(a) To UBound(a)
If Trim(a(i)) <> "" Then '排除空行
If InStr(Trim(a(i)), ": ") > 0 Then '判断是否符合处理条件
If InStr(Trim(a(i)), ": ") > 0 And InStr(Trim(a(i)), "=") > 0 Then
e = e & "Dim " & Split(Split(Trim(a(i)), ": ")(1), "=")(0) & " As String" & vbCrLf
If InStr(Trim(a(i)), ";") > 0 Then
b = b & Split(Split(Trim(a(i)), ": ")(1), "=")(0) & " = " & "Split(Split(Text2.Text, " & Chr(34) & Split(Split(Trim(a(i)), ": ")(1), "=")(0) & "=" & Chr(34) & ")(1), " & Chr(34) & ";" & Chr(34) & ")(0)" & vbCrLf
End If
End If
End If
End If
Next
Text2.Text = e & vbCrLf & b
On Error Resume Next
Clipboard.Clear
Clipboard.SetText Text2.Text
MsgBox "代码已复制成功！", vbOKOnly, "提示"
End Sub
Public Function 删除所有空行(ByVal 文本 As String) As String '任何空行都会清空
Dim a() As String
Dim b As Integer
Dim c As String
a = Split(文本, vbCrLf)
For b = LBound(a) To UBound(a)
If Trim(a(b)) <> "" Then
c = c & Trim(a(b)) & vbCrLf
End If
Next b
Do While Left(c, 1) = Chr(13) Or Left(c, 1) = Chr(10)
c = Right(c, Len(c) - 1)
Loop
Do While Right(c, 1) = Chr(13) Or Right(c, 1) = Chr(10)
c = Left(c, Len(c) - 1)
Loop
删除所有空行 = c
End Function
好例子网口号：伸出你的我的手 — 分享！
小贴士
感谢您为本站写下的评论，您的评论对其它用户来说具有重要的参考价值，所以请认真填写。
- 类似“顶”、“沙发”之类没有营养的文字，对勤劳贡献的楼主来说是令人沮丧的反馈信息。
- 相信您也不想看到一排文字/表情墙，所以请不要反馈意义不大的重复字符，也请尽量不要纯表情的回复。
- 提问之前请再仔细看一遍楼主的说明，或许是您遗漏了。
- 请勿到处挖坑绊人、招贴广告。既占空间让人厌烦，又没人会搭理，于人于己都无利。
关于好例子网
本站旨在为广大IT学习爱好者提供一个非营利性互相学习交流分享平台。本站所有资源都可以被免费获取学习研究。本站资源来自网友分享，对搜索内容的合法性不具有预见性、识别性、控制性，仅供学习研究，请务必在下载后24小时内给予删除，不得用于其他任何用途，否则后果自负。基于互联网的特殊性，平台无法对用户传输的作品、信息、内容的权属或合法性、安全性、合规性、真实性、科学性、完整权、有效性等进行实质审查；无论平台是否已进行审查，用户均应自行承担因其传输的作品、信息、内容而可能或已经产生的侵权或权属纠纷等法律责任。本站所有资源不代表本站的观点或立场，基于网友分享，根据中国法律《信息网络传播权保护条例》第二十二与二十三条之规定，若资源存在侵权或相关问题请联系本站客服人员，点此联系我们。关于更多版权及免责申明参见 版权及免责申明
网友评论
我要评论