VERSION 5.00
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form Form1 
   Caption         =   "局域网分享服务端"
   ClientHeight    =   5565
   ClientLeft      =   225
   ClientTop       =   855
   ClientWidth     =   7620
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   5565
   ScaleWidth      =   7620
   StartUpPosition =   3  '窗口缺省
   Begin VB.Timer gbwj 
      Enabled         =   0   'False
      Interval        =   6000
      Left            =   5280
      Top             =   0
   End
   Begin VB.Timer fswj 
      Enabled         =   0   'False
      Interval        =   1000
      Left            =   6000
      Top             =   0
   End
   Begin VB.Timer fsxx 
      Enabled         =   0   'False
      Index           =   0
      Interval        =   600
      Left            =   4560
      Top             =   0
   End
   Begin MSWinsockLib.Winsock fwq 
      Index           =   0
      Left            =   4320
      Top             =   5400
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.Frame Frame2 
      Caption         =   "文件"
      Height          =   5055
      Left            =   3720
      TabIndex        =   2
      Top             =   240
      Width           =   3615
      Begin VB.ListBox List2 
         Height          =   4380
         Left            =   120
         TabIndex        =   3
         Top             =   360
         Width           =   3375
      End
   End
   Begin VB.Frame Frame1 
      Caption         =   "在线用户"
      Height          =   5055
      Left            =   240
      TabIndex        =   0
      Top             =   240
      Width           =   3255
      Begin VB.ListBox List1 
         Height          =   4380
         Left            =   120
         TabIndex        =   1
         Top             =   360
         Width           =   3015
      End
   End
   Begin VB.Menu bj 
      Caption         =   "bj"
      Begin VB.Menu sc 
         Caption         =   "删除"
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim wjs As Long '定义文件数量
Dim wjlj As String, wjmc As String, wjcd As Long, wjnr() As Byte
Dim pds As Boolean
Dim scwjm As String, scsj() As Byte, sccd As Long, aa As Integer, xlh As String, fwqsl As Long
Dim zwjsl As Long

Private Sub Form_Load()
fwq(0).LocalPort = 1002 '当地ip
fwq(0).Listen '当地ip
bj.Visible = False
Call jzwj
pds = False
End Sub

Private Sub Form_Unload(Cancel As Integer)
'fwq.SendData "我先休息一下"
End Sub

Private Sub fswj_Timer()
Open wjlj For Binary As #2
Get #2, , wjnr
Close #2
fwq(zwjsl).SendData wjnr
fswj.Enabled = False
End Sub


Private Sub fsxx_Timer(Index As Integer)
Dim i As Integer, cd As Long
'Index = fwqsl
cd = List2.ListCount
For i = 0 To cd - 1

fwq(Index).SendData List2.List(i)
Next i
fsxx(Index).Enabled = False
End Sub

Private Sub fwq_Close(Index As Integer)
'fwq(fwqsl).Close
'fwq(fwqsl).Listen
End Sub
Private Sub fwq_ConnectionRequest(Index As Integer, ByVal requestID As Long)
'If fwq.State <> sckClosed Then
'fwq.Close
'End If
If requestID <> 0 Then '不等于0
fwqsl = fwqsl + 1
Load fwq(fwqsl)
fwq(fwqsl).Accept requestID
fwq(fwqsl).SendData "我是服务"
Load fsxx(fwqsl)
fsxx(fwqsl).Interval = 600
fsxx(fwqsl).Enabled = True
List1.AddItem fwq(fwqsl).RemoteHostIP '远程ip
End If '不等于0
End Sub

Private Sub fwq_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Dim sj As String, mmsj As String, wz As Integer, i As Integer
zwjsl = Index
List1.AddItem Index
If pds = False Then '判断分析
fwq(Index).GetData sj

If Left(sj, 2) = "下载" Then '下载文件

wjmc = Right(sj, Len(sj) - 2)

wjlj = App.Path & "\文件储存器\" & wjmc
wjcd = FileLen(wjlj)
ReDim wjnr(wjcd)
fwq(Index).SendData "长度>" & wjcd
fswj.Enabled = True
End If '下载文件


If Left(sj, 2) = "删除" Then '删除文件
wjmc = Right(sj, Len(sj) - 2)
wjlj = App.Path & "\文件储存器\" & wjmc
If Dir(wjlj) = "" Then '判断文件是否存在
fwq(Index).SendData "否"
Else '判断文件是否存在
Kill (wjlj)
fwq(Index).SendData "是"
List2.Clear
Call jzwj

End If '判断文件是否存在
End If '删除文件


If sj = "刷新" Then '刷新列表
List2.Clear
Call jzwj

fsxx(Index).Enabled = True
End If '刷新列表

If InStr(sj, "*") <> 0 Then '重命名
wz = InStr(sj, "*")
mmsj = Left(sj, wz - 1)
wjmc = Right(sj, Len(sj) - wz)

Dim OldName, NewName
OldName = App.Path & "\文件储存器\" & wjmc: NewName = App.Path & "\文件储存器\" & mmsj
Name OldName As NewName  ' 更改文件名。
List2.Clear
Call jzwj
End If '重命名


'If Left(sj, 2) = "上传" Then '上传1段
''sccd = Right(sj, Len(sj) - 2)
'ReDim scsj(sccd)
'End If '上传1段

If Left(sj, 3) = "文件名" Then '上传2段
scwjm = Right(sj, Len(sj) - 3)
For i = 0 To List2.ListCount - 1 '处理重名
If scwjm = List2.List(i) Then
Call hqxlh
End If
Next i '处理重名

aa = FreeFile
Open App.Path & "\文件储存器\" & scwjm For Binary As #aa
fwq(Index).SendData "可以了"
pds = True
End If '上传2段
End If '判断分析
If pds = True Then '上传数据
ReDim scsj(1 To bytesTotal)
fwq(Index).GetData scsj
'Open App.Path & "\文件储存器\" & scwjm For Binary As #aa
Put #aa, , scsj
gbwj.Enabled = True
End If '上传数据
End Sub

Private Sub fwq_Error(Index As Integer, 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)
'fwq.Close
'fwq.Listen '监听
End Sub

Private Sub gbwj_Timer()
Close #aa
pds = False
gbwj.Enabled = False
End Sub

Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim cd As Menu
If Button = 2 Then
Set cd = bj
PopupMenu bj
End If
'MsgBox List2.ListIndex
End Sub

Private Sub sc_Click()
Dim i As Integer
If List2.ListIndex >= 0 Then
Kill (App.Path & "\文件储存器\" & List2.List(List2.ListIndex))
For i = 1 To fwqsl
fwq(i).SendData "删除" & List2.ListIndex + 1

Next i
List2.RemoveItem List2.ListIndex

Else
MsgBox "请选择项目！！", vbInformation, "zwj共享"
End If
End Sub
Private Sub jzwj()
FileName = Dir(App.Path & "\文件储存器\", vbDirectory)
Do While FileName <> "" '循环分析

If FileName <> "." And FileName <> ".." Then '判读分析

List2.AddItem FileName

End If '判读分析

FileName = Dir
Loop '循环分析



End Sub
Private Sub hqxlh()
Dim cd As Integer, n As Integer, i As Integer, m As Integer, nr As String, xlhsz(30) As String
cd = Len(Now())
For i = 1 To cd  '抽取每一个数据
n = n + 1
nr = Mid(Now(), i, 1)

If Asc(nr) < 58 And Asc(nr) > 47 Then '帅选数据
xlhsz(n) = nr
End If '帅选数据
Next i '抽取每一个数据
For m = 1 To n
xlh = xlh & xlhsz(m)

Next m
scwjm = Left(scwjm, Len(scwjm) - 4) & xlh & Right(scwjm, 4)

End Sub
