⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 form1.frm

📁 P2P文件共享系统,新手入门建议下载阅读.
💻 FRM
📖 第 1 页 / 共 4 页
字号:
Frame7.Width = Frame6.Width
ProgressBar1.Width = Frame7.Width - (ProgressBar1.Left * 2)
Slider1.Width = Frame6.Width - (Slider1.Left * 2)
Label4.Left = Slider1.Left + Slider1.Width + 50
Label5.Width = Frame2.Width - Label5.Left - 50
Frame8.Height = MSFlexGrid1.Height + Command4.Height
End Sub

Private Sub Form_Unload(Cancel As Integer)
End
End Sub

Private Sub mnuClear_Click()
Text1 = ""
MSFlexGrid1.Rows = 1
MSFlexGrid2.Rows = 1
strtIpGroup(0) = "24"
strtIpGroup(1) = "66"
strtIpGroup(2) = "0"
strtIpGroup(3) = "0"
endIPGroup(0) = "24"
endIPGroup(1) = "66"
endIPGroup(2) = "255"
endIPGroup(3) = "255"
Command6_Click
End Sub

Private Sub mnuExit_Click()
End
End Sub

Private Sub msflexgrid1_DblClick()
Dim SPEED, StartSeconds, StartMinutes, StartHours, EndSeconds, EndMinutes, EndHours, TotalSeconds, TotalMinutes, TotalHours, Secs, Mins, Hours, Temp, Temp1, Temp2
On Error Resume Next
MSFlexGrid1.Col = MSFlexGrid1.Col + 2
T = "http://" & MSFlexGrid1.Text & ":1214"
If MSFlexGrid1.Text = "" Then
    MsgBox "Cannot Find Host"
    Exit Sub
End If
Timer2.Enabled = False
Temp = Time
        Err.Number = 0
        List1.Clear
Dim strtextline
    If Check2.Value = 1 Then
        Open App.Path & "\Cache\" & MSFlexGrid1.Text & ".tmp" For Input As #1
            If Err.Number = 76 Then
                MkDir App.Path & "\Cache"
                GoTo GetList
            ElseIf Err.Number = 53 Then GoTo GetList
            End If
            If Check3.Value = 0 Then Form4.Check1.Value = 1 Else Form4.Check1.Value = 0
            If Check3.Value = 1 Then Form4.Show 1
            If Form4.Check1.Value = 0 Then Check3.Value = 1 Else Check3.Value = 0
            If Form4.Temp = "1" Then GoTo GetList
            i = 0
            Do While Not EOF(1)
                Line Input #1, strtextline
                If i = 1 And strtextline <> Chr(34) And strtextline <> "" And strtextline <> vbCrLf And strtextline <> Chr(10) And strtextline <> Chr(13) Then List1.AddItem strtextline
                i = 1
            Loop
        Close #1
        If List1.ListCount > 0 Then GoTo AlreadyCached
    End If
GetList:
Text2.Text = Inet1.OpenURL("http://" & MSFlexGrid1.Text & ":1214")
Temp2 = Time

StartSeconds = Left(Right(Temp, 5), 2)
StartMinutes = Left(Right(Temp, 8), 2)
StartHours = Left(Temp, 2)

EndSeconds = Left(Right(Temp2, 5), 2)
EndMinutes = Left(Right(Temp2, 8), 2)
EndHours = Left(Temp2, 2)

TotalSeconds = EndSeconds - StartSeconds
TotalMinutes = EndMinutes - StartMinutes
If Right(EndHours, 1) = ":" Then EndHours = Left(EndHours, 1)
If Right(StartHours, 1) = ":" Then StartHours = Left(StartHours, 1)
TotalHours = EndHours - StartHours

TotalMinutes = TotalMinutes + (TotalHours * 60) + (TotalSeconds / 60)
TotalSeconds = TotalMinutes * 60
TotalHours = TotalMinutes / 60

SPEED = (((1 / TotalSeconds) * Len(Text2.Text)) / 1034) * 4

Text2.Text = Text2.Text
        Text2.Text = Replace(Text2.Text, Chr(10), vbCrLf, 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, "<tr><td><a href=", vbCrLf, 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, Chr(34) & ">", vbCrLf, 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, Chr(34), "", 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, "</a><td>", vbCrLf, 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, "<html><body><table>", "", 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, "</table></body></html>", "", 1, Len(Text2.Text), vbTextCompare)
        Text2.Text = Replace(Text2.Text, vbCrLf & vbCrLf, vbCrLf, 1, Len(Text2.Text), vbTextCompare)
    If Asc(Left(Text2.Text, 1)) = 13 Then Text2.Text = Right(Text2.Text, Len(Text2.Text) - 1)
    If Asc(Left(Text2.Text, 1)) = 10 Then Text2.Text = Right(Text2.Text, Len(Text2.Text) - 1)
    If Asc(Right(Text2.Text, 1)) = 13 Then Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1)
    If Asc(Right(Text2.Text, 1)) = 10 Then Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1)
    If Asc(Right(Text2.Text, 1)) = 13 Then Text2.Text = Left(Text2.Text, Len(Text2.Text) - 1)

    List1.Clear
    ProgressBar1.Max = Len(Text2.Text)
    MSFlexGrid2.Rows = 1
    If Check2.Value = 1 Then
        Open App.Path & "\Cache\" & MSFlexGrid1.Text & ".tmp" For Output As #1
            Write #1, vbCrLf & Text2.Text & vbCrLf
        Close #1
        Open App.Path & "\Cache\" & MSFlexGrid1.Text & ".tmp" For Input As #1
            i = 0
            Do While Not EOF(1)
                Line Input #1, strtextline
                If i = 0 Then GoTo NextLine1
                If i = 1 And strtextline <> Chr(34) And strtextline <> "" And strtextline <> vbCrLf And strtextline <> Chr(10) And strtextline <> Chr(13) Then List1.AddItem strtextline
NextLine1:
                i = 1
            Loop
        Close #1
    Else
        Open App.Path & "\Temp.tmp" For Output As #1
            Write #1, vbCrLf & Text2.Text & vbCrLf
        Close #1
        Open App.Path & "\Temp.tmp" For Input As #1
            i = 0
            Do While Not EOF(1)
                Line Input #1, strtextline
                If i = 0 Then GoTo NextLine
                If i = 1 And strtextline <> Chr(34) And strtextline <> "" And strtextline <> vbCrLf And strtextline <> Chr(10) And strtextline <> Chr(13) Then List1.AddItem strtextline
NextLine:
                i = 1
            Loop
        Close #1
        Kill App.Path & "\Cache\Temp.tmp"
    End If
AlreadyCached:
    With MSFlexGrid2
        .Clear
        .Row = 0
        .Col = 0
        .Text = "Filename"
        .CellFontBold = True
        .Col = 1
        .Text = "Size"
        .CellFontBold = True
        .Col = 2
        .Text = "Download Time"
        .CellFontBold = True
        .Col = 3
        .Text = "Username"
        .CellFontBold = True
        .Col = 4
        .Text = "URL"
        .CellFontBold = True
        .Rows = List1.ListCount / 3 + 1
        ProgressBar1.Max = List1.ListCount
        If .Rows = 1 Then
            MsgBox "No Results", vbOKOnly + vbInformation, "Complete"
            Timer2.Interval = -Slider1.Value
            Timer2_Timer
            Exit Sub
        End If
        .Visible = False
        .Col = 4
        For i = 0 To List1.ListCount Step 3
            ProgressBar1.Value = ProgressBar1.Value + 1
            .Row = i / 3 + 1
            .Text = T & List1.List(i)
            .CellFontBold = False
            .CellAlignment = 0
        Next i
        MSFlexGrid1.Col = MSFlexGrid1.Col - 2
        .Col = 3
        For i = 1 To MSFlexGrid2.Rows - 1
            ProgressBar1.Value = ProgressBar1.Value + 1
            .Row = i
            .Text = MSFlexGrid1.Text
        Next i
        .Row = 0
        .Col = 0
        For i = 1 To List1.ListCount Step 3
            ProgressBar1.Value = ProgressBar1.Value + 1
            .Row = .Row + 1
            .Text = List1.List(i)
            .CellFontBold = False
            .CellAlignment = 0
        Next i
        .Row = 0
        For i = 2 To List1.ListCount Step 3
            ProgressBar1.Value = ProgressBar1.Value + 1
        
            .Row = .Row + 1
            .Col = 2
                Secs = Int((List1.List(i) / SPEED) / 1034.368)
                Mins = 0
                Do While Secs >= 60
                    Mins = Mins + 1
                    Secs = Secs - 60
                Loop
                Do While Mins >= 60
                    Hours = Hours + 1
                    Mins = Mins - 60
                Loop
                If Len(Secs) = 1 Then Secs = "0" & Secs
                If Hours > 0 Then
                    If Len(Mins) = 1 Then Mins = "0" & Mins
                    .Text = Hours & ":" & Mins & ":" & Secs
                ElseIf Hours <= 0 Then
                    .Text = Mins & ":" & Secs
                ElseIf Hours <= 0 And Mins <= 0 Then
                    .Text = Secs & " seconds."
                End If
            .Col = 1
            If List1.List(i) / 1024.368 < 1000 Then
                .Text = Round(List1.List(i) / 1024.368, 2) & " kb"
            Else
                .Text = Round(List1.List(i) / 1024368, 2) & " mb"
            End If
            .CellFontBold = False
            .CellAlignment = 0
        Next i
    End With
    MSFlexGrid2.Visible = True
    Timer2.Interval = -Slider1.Value
Timer2.Enabled = True
End Sub

Private Sub MSFlexGrid1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer2.Interval = 5000
End Sub

Private Sub MSFlexGrid2_DblClick()
On Error Resume Next
Dim Buffer As String
MSFlexGrid2.Col = 4
Buffer = Buffer & vbCrLf & "URL:" & MSFlexGrid2.Text & vbCrLf
MSFlexGrid2.Col = 3
Buffer = Buffer & "USR:" & MSFlexGrid2.Text & vbCrLf
MSFlexGrid2.Col = 0
Buffer = Buffer & "FLE:" & MSFlexGrid2.Text & vbCrLf
Open App.Path & "\DINFO.tmp" For Output As #1
    Write #1, Buffer
Close #1
Shell App.Path & "\DownloadFile.KMD"
'Load New Form2
'Shell ("c:\program files\internet explorer\iexplore.exe " & Chr(34) & Replace(MSFlexGrid2.Text, "+", " ", 1, Len(MSFlexGrid2.Text), vbTextCompare) & Chr(34))
End Sub

Private Sub Option1_Click()
Text1.SetFocus
End Sub

Private Sub Option2_Click()
Text1.SetFocus
End Sub

Private Sub Option3_Click()
Text1.SetFocus
End Sub

Private Sub Option5_Click()
MSFlexGrid1.Visible = False
Frame8.Visible = True
Frame8.ZOrder
Text1.SetFocus
End Sub

Private Sub Option6_Click()
Text1.SetFocus
End Sub

Private Sub Option7_Click()
Text1.SetFocus
End Sub

Private Sub Option8_Click()
Text1.SetFocus
End Sub

Private Sub SearchAll_Click()
Text1.SetFocus
Frame4.Visible = True
Frame4.ZOrder
Frame3.Visible = False
SearchCurrent.Top = Frame4.Top + Frame4.Height + 50
End Sub

Private Sub SearchCurrent_Click()
Text1.SetFocus
SearchCurrent.Top = SearchAll.Top + SearchAll.Height + 50
Frame3.Top = SearchCurrent.Top + SearchCurrent.Height + 50
Frame3.ZOrder
Frame3.Visible = True
Frame4.Visible = False
End Sub

Private Sub Slider1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
Timer2.Interval = -Slider1.Value
End Sub

Private Sub Timer1_Timer()
With MSFlexGrid2
    Label5.Caption = " " & .Rows - 1 & " Result(s)"
    If .ScrollBars = flexScrollBarBoth Then
        If .ColWidth(0) + .ColWidth(1) + .ColWidth(2) + .ColWidth(3) + .ColWidth(4) < .Width Then .ScrollBars = flexScrollBarVertical
    Else
        If .ColWidth(0) + .ColWidth(1) + .ColWidth(2) + .ColWidth(3) + .ColWidth(4) > .Width Then .ScrollBars = flexScrollBarBoth
    End If
End With
Select Case Me.Caption
    Case "My KaZaA"
        If ChangeTime >= 50 Then
            Me.Caption = "My Morpheus"
            ChangeTime = 0
        End If
    Case "My Morpheus"
        If ChangeTime >= 50 Then
            Me.Caption = "My KaZaA"
            ChangeTime = 0
        End If
End Select
ChangeTime = ChangeTime + 1
If Text1 = "" Then Command1.Enabled = False Else Command1.Enabled = True
End Sub
Private Sub Timer2_Timer()
Dim Host
Timer2.Interval = -Slider1.Value
Timer2.Enabled = True
On Error Resume Next
If Form3.Visible = True Then Exit Sub
If Form5.Visible = True Then Exit Sub
If Form6.Visible = True Then Exit Sub
If frmAbout.Visible = True Then Exit Sub
Select Case Command5.Enabled
    Case False
        ProgressBar1.Max = endIPGroup(2) * endIPGroup(3)
        ProgressBar1.Value = strtIpGroup(2) * strtIpGroup(3)
        Load Winsock(Winsock.UBound + 1)
        Host = strtIpGroup(0) & "." & strtIpGroup(1) & "." & strtIpGroup(2) & "." & strtIpGroup(3)
        Winsock(Winsock.UBound).Close
        Winsock(Winsock.UBound).Connect Host, 1214
        
        If Winsock.UBound > 100 Then Unload Winsock(Winsock.UBound - 100)

        If Val(strtIpGroup(3)) < Val(endIPGroup(3)) Then
            strtIpGroup(3).Text = Val(strtIpGroup(3)) + 1
        Else
            strtIpGroup(3) = 0
            If Val(strtIpGroup(2)) < Val(endIPGroup(2)) Then
                strtIpGroup(2) = Val(strtIpGroup(2)) + 1
            Else
                MsgBox "Scan Complete", vbOKOnly + vbInformation, Me.Caption
                Command6_Click
            End If
        End If
End Select
End Sub

Private Sub Winsock_Connect(Index As Integer)
Winsock(Index).SendData "PASS Admin" & vbCrLf & "NICK M{iN}M" & vbCrLf & "USER KaZaAClone " & Winsock(Index).LocalIP & ":KaZaA"
End Sub

Private Sub Winsock_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim DATA As String, KaZaAUser, added As Boolean
'On Error GoTo X
On Error Resume Next
T = Winsock(Index).RemoteHostIP
Winsock(Index).GetData DATA, vbString
    
If InStr(1, DATA, "MusicCity", vbTextCompare) Then KaZaAUser = False Else KaZaAUser = True
    DATA = Replace(DATA, "HTTP/1.0 501 Not Implemented", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "X-Kazaa-Username: ", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, Winsock(Index).RemoteHostIP, "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "X-Kazaa-Network: KaZaA", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, " ", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "X-Kazaa-IP:", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, ":1214", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, vbCrLf, "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "X-Kazaa-SupernodeIP:", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "X-Kazaa-Network:", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "MusicCity", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, ".", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "0", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "1", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "2", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "3", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "4", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "5", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "6", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "7", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "8", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "9", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, Chr(10), "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, "???", "", 1, Len(DATA), vbTextCompare)
    DATA = Replace(DATA, " ", "", 1, Len(DATA), vbTextCompare)
    
If KaZaAUser = True Then MSFlexGrid1.Col = 0 Else MSFlexGrid1.Col = 1
Changed = True
    added = False
    For i = 0 To MSFlexGrid1.Rows - 1
        MSFlexGrid1.Row = i
        If MSFlexGrid1.Text = "" Then
            MSFlexGrid1.Text = DATA
            MSFlexGrid1.Col = MSFlexGrid1.Col + 2
            MSFlexGrid1.Text = T
            MSFlexGrid1.Col = MSFlexGrid1.Col - 2
            added = True
            Exit For
        End If
    Next i
    If added = False Then
        MSFlexGrid1.Rows = MSFlexGrid1.Rows + 1
        MSFlexGrid1.Row = MSFlexGrid1.Rows - 1
        MSFlexGrid1.Text = DATA
        MSFlexGrid1.Col = MSFlexGrid1.Col + 2
        MSFlexGrid1.Text = T
        MSFlexGrid1.Col = MSFlexGrid1.Col - 2
    End If
X:
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -