📄 frmsender.frm
字号:
TabIndex = 39
Top = 120
Width = 1335
End
Begin VB.Label Label1
BackStyle = 0 'Transparent
Caption = "用户:"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FFFFFF&
Height = 225
Index = 0
Left = 1800
TabIndex = 19
Top = 120
Width = 615
End
Begin VB.Line Line1
X1 = 0
X2 = 240
Y1 = 480
Y2 = 480
End
End
Begin VB.PictureBox MyButtonDefSkin
AutoRedraw = -1 'True
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 315
Left = 1560
Picture = "frmSender.frx":A1CC
ScaleHeight = 21
ScaleMode = 3 'Pixel
ScaleWidth = 150
TabIndex = 16
Top = 6240
Width = 2250
End
Begin MSComDlg.CommonDialog cd1
Left = 5040
Top = 6120
_ExtentX = 847
_ExtentY = 847
_Version = 393216
End
Begin VB.Frame famRemoteInfo
Caption = "Remote Receiver Information"
Height = 1215
Left = 7320
TabIndex = 1
Top = 120
Width = 5655
Begin VB.TextBox txtRemotePortBinary
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 285
Left = 2400
Locked = -1 'True
TabIndex = 6
Top = 840
Width = 3135
End
Begin VB.TextBox txtRemotePortInfo
Alignment = 2 'Center
Appearance = 0 'Flat
Height = 285
Left = 2400
Locked = -1 'True
TabIndex = 5
Top = 600
Width = 3135
End
Begin VB.CommandButton cmdConnect
Caption = "&Connect to remote receiver"
Height = 285
Left = 120
TabIndex = 2
Top = 240
Visible = 0 'False
Width = 2295
End
Begin VB.Label Label3
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Remote Port(Binary):"
Height = 255
Left = 120
TabIndex = 4
Top = 840
Width = 2295
End
Begin VB.Label Label2
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Remote Port(Info):"
Height = 255
Left = 120
TabIndex = 3
Top = 600
Width = 2295
End
End
Begin VB.Frame famSendOption
Caption = "Send File Option"
Enabled = 0 'False
Height = 1815
Left = 7320
TabIndex = 0
Top = 1200
Width = 5655
Begin VB.TextBox txtChunkSize
Alignment = 2 'Center
Appearance = 0 'Flat
BorderStyle = 0 'None
Height = 195
Left = 2400
TabIndex = 17
Text = "4096"
Top = 1080
Width = 3135
End
Begin VB.Label Label6
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Chunk Size(in bytes):"
Height = 255
Left = 120
TabIndex = 10
Top = 1080
Width = 2295
End
Begin VB.Label Label5
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Total File Size(in bytes):"
Height = 255
Left = 120
TabIndex = 9
Top = 840
Width = 2295
End
Begin VB.Label Label4
BackStyle = 0 'Transparent
Caption = "The file in local machine you want to send:"
Height = 375
Left = 120
TabIndex = 8
Top = 240
Width = 4095
End
End
Begin VB.Frame famSendStatus
Caption = "Send File Status"
Height = 1095
Left = 7320
TabIndex = 11
Top = 3000
Width = 5655
Begin VB.Timer tmrStatus
Enabled = 0 'False
Interval = 500
Left = 240
Top = 360
End
Begin VB.Label lblPercentage
Alignment = 2 'Center
BackStyle = 0 'Transparent
Caption = "Percentage"
Height = 255
Left = 3120
TabIndex = 15
Top = 480
Width = 1815
End
Begin VB.Label lblTotalByteSent
Alignment = 2 'Center
Appearance = 0 'Flat
BackColor = &H80000005&
BorderStyle = 1 'Fixed Single
Caption = "0"
ForeColor = &H80000008&
Height = 255
Left = 2400
TabIndex = 14
Top = 240
Width = 3135
End
Begin VB.Label Label8
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Sending Speed(KBps):"
Height = 255
Left = 120
TabIndex = 13
Top = 720
Width = 2295
End
Begin VB.Label Label7
Alignment = 1 'Right Justify
BackStyle = 0 'Transparent
Caption = "Total Bytes Sent:"
Height = 255
Left = 120
TabIndex = 12
Top = 240
Width = 2295
End
End
Begin VB.Frame famLog
Caption = "Event Log"
Height = 1935
Left = 7320
TabIndex = 7
Top = 4080
Width = 5655
End
Begin MSWinsockLib.Winsock udprequest
Left = 2760
Top = 3840
_ExtentX = 741
_ExtentY = 741
_Version = 393216
Protocol = 1
End
End
Attribute VB_Name = "frmSender"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
' ：） 人人为我，我为人人 ：）
'枕善居汉化收藏整理
'发布日期：05/08/03
'描 述：我的网络聊天室 (客户端)
'网 站：http://www.mndsoft.com/
'e-mail ：mnd@mndsoft.com
'OICQ ：88382850
'****************************************************************************
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_PASTE = &H302
'Round the form
Dim rndfrm As New ROUND_FORM
Dim mProgress As Long
Dim mProgressMax As Long
Dim mPercentage As Long
Dim FLAG As Boolean
Private Sub cmdBrowse_Click()
With cd1
.Filter = "All Files *.*|*.*"
.CancelError = True
.Flags = cdlOFNFileMustExist
On Error GoTo 1
.ShowOpen
txtSource.Text = .Filename
cmdSend.Enabled = True
End With
Exit Sub
1
End Sub
Private Sub cmdClose_Click()
If pb.Value < 2 Then
Me.Hide
Sender.Reset
FLAG = False
End If
End Sub
Private Sub cmdRequest_Click()
If txtRemoteHost.Text <> "" Then
FLAG = True
udprequest.RemoteHost = txtRemoteHost.Text
udprequest.RemotePort = 5000
udprequest.SendData Client.txtclientname & ":FTR"
DoEvents
Else
MsgBox "Please select the user from the list to whom you want to send the file.", vbInformation, "Information"
End If
End Sub
Private Sub cmdSend_Click()
cmdSend.Enabled = False
Sender.ChunkSize = CLng(txtChunkSize.Text)
Sender.Source = txtSource.Text
txtTotalFileSize.Text = Sender.CurrentFileSize
Sender.SendInfo
AddLog "File Information Sent to " & Sender.RemoteHost
AddLog "File Name= " & Sender.CurrentFileName
AddLog "File Size(in bytes)= " & Sender.CurrentFileSize
AddLog "Waiting for receiver[" & Sender.RemoteHostIP & "] ready signal..."
End Sub
Private Sub Form_Load()
Me.Show
Me.Move 0, 0
'round form shape
rndfrm.ROUND_FORM Me, 12, 1, 1
'fill combo with usernames
For i = 1 To Client.lstusers.ListCount - 1
txtRemoteHost.AddItem Client.lstusers.List(i)
Next
End Sub
Private Sub Label1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage Me.hWnd, &HA1, 2, 0
Exit Sub
End If
End Sub
Private Sub Sender_CommandAccepted()
AddLog "Sending command accepted by [" & Sender.RemoteHostIP & "]"
AddLog "File Sending Started at " & Time
AddLog "Now sending file [" & Sender.Source & "]"
tmrStatus.Enabled = True
Sender.SendFile
End Sub
Private Sub Sender_CommandRefused()
AddLog "Sending command refused by [" & Sender.RemoteHostIP & "]"
Sender.ResetFile
mProgress = 0
mProgressMax = 0
mPercentage = 0
pb.Value = 0
cmdConnect.Enabled = False
cmdSend.Enabled = True
famSendOption.Enabled = True
End Sub
Private Sub Sender_Connect()
AddLog "<Sender Control> connected to [" & Sender.RemoteHost & "] successfully."
txtRemotePortInfo.Text = Sender.RemotePortInfo
txtRemotePortBinary.Text = Sender.RemotePortBinary
famSendOption.Enabled = True
End Sub
Private Sub Sender_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
MsgBox Description, vbCritical, Number
If Number = 10049 Then cmdConnect.Enabled = True
End Sub
Private Sub Sender_SendComplete()
tmrStatus.Enabled = False
AddLog "File Sending Complete at " & Time
Sender.ResetFile
mProgress = 0
mProgressMax = 0
mPercentage = 0
pb.Value = 0
lblPercentage.Caption = "100%"
cmdConnect.Enabled = False
cmdSend.Enabled = True
famSendOption.Enabled = True
End Sub
Private Sub Sender_SendProgress(ByVal Progress As Long, ByVal ProgressMax As Long)
mProgress = Progress
mProgressMax = ProgressMax
End Sub
Sub AddLog(str As String)
txtEventLog.Text = txtEventLog.Text & str & vbCrLf
txtEventLog.SelStart = Len(txtEventLog.Text)
End Sub
Private Sub Sender_SpeedRecord(ByVal Speed As Long)
txtSpeed.Text = Speed
End Sub
Private Sub tmrStatus_Timer()
pb.Max = mProgressMax
pb.Value = mProgress
lblTotalByteSent.Caption = mProgress
lblPercentage.Caption = (Int(mProgress / mProgressMax * 100) + 1) & "%"
End Sub
Private Sub udprequest_DataArrival(ByVal bytesTotal As Long)
Dim Msg As String
udprequest.GetData Msg
If Msg = "YES" And FLAG = True Then
Me.Show
Sender.RemoteHost = txtRemoteHost.Text
Sender.Connect
Frame1.Enabled = True
ElseIf Msg = "NO" Then
MsgBox txtRemoteHost.Text & " declined to accept the file.", vbCritical, "FTP declined ..."
ElseIf Msg = "RESET" Then
Sender.Reset
Frame1.Enabled = False
txtRemoteHost.Text = " "
txtEventLog.Text = ""
FLAG = False
End If
End Sub
Private Sub WindowBorder_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 1 Then
ReleaseCapture
SendMessage Me.hWnd, &HA1, 2, 0
Exit Sub
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -