form1.frm

这些是我特地制作的分布式计算的示例程序

      Height          =   1095
      Left            =   120
      TabIndex        =   0
      Top             =   0
      Width           =   5175
      Begin VB.CommandButton ListenCommand 
         Caption         =   "监听"
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   495
         Left            =   3600
         TabIndex        =   3
         Top             =   360
         Width           =   1455
      End
      Begin VB.TextBox ListenText 
         Alignment       =   1  'Right Justify
         Height          =   270
         Left            =   1440
         TabIndex        =   2
         Text            =   "12345"
         Top             =   480
         Width           =   1815
      End
      Begin VB.Label Label1 
         Caption         =   "监听端口："
         BeginProperty Font 
            Name            =   "宋体"
            Size            =   12
            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         Height          =   375
         Left            =   120
         TabIndex        =   1
         Top             =   480
         Width           =   1335
      End
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'分布式计算开发示例
'原作者 郝佳男
Private Sub ClearCommand_Click()
Rem event when Clear button click

'prevent reload , set disabled
ClearCommand.Enabled = False
'zero the task number
TaskN = 0
'clear the list
TaskStList.Clear
'recover the generate button
GenCommand.Enabled = True
'add to log
AddLog "任务已清除"
'recover clear button
ClearCommand.Enabled = True
End Sub

Private Sub ExitCommand_Click()
Rem event when click exit button

'call save function
Call SavetoMDB
'exit the program
End
End Sub

Private Sub Form_Load()
Rem event when window is ready

'zero the task number
TaskN = 0
'zero the Socket number
'socket number is needed to load Winsock ActiveX
SocketN = 0
'set time out default value
MAXMINUTE = 10
'add to log
AddLog "从数据库中读取初始值"
'read data from database
Call ReadFromMDB
'initialize the task status list
Call InitTaskStList
'update the timeout textbox value
TimeoutText.Text = CStr(MAXMINUTE)
'judge if no task is running
If TaskN <> 0 Then
'task is running
 'disbale the generate button
 GenCommand.Enabled = False
End If
'add to log
AddLog "初始化完成"
'show the window
Form1.Show
End Sub

Private Sub Form_Terminate()
Rem event ehen program terminated

'MDBCon.Close
'close database connector handle
Set MDBCon = Nothing
End Sub

Private Sub Frame3_DragDrop(Source As Control, X As Single, Y As Single)

End Sub

Private Sub GenCommand_Click()
Rem event when generate button clicked

Dim BeginN As Long, EndN As Long, CountN As Long, TimeOut As Long
Dim i As Long, j As Long, k As Long
'prevent reload
GenCommand.Enabled = False
'get begin position from textbox
BeginN = CLng(BeginText.Text)
'get end position from textbox
EndN = CLng(EndText.Text)
'get the task number
CountN = CLng(TaskNText.Text)
'get tiemout value from textbox
TimeOut = CLng(TimeoutText.Text)
'judge if the input data is error
If BeginN > EndN Or EndN - BeginN + 1 < CountN Or CountN > MAXTASKN Then
'input data is error
 'show a warning message
 MsgBox "输入数据错误", , "错误"
 'recover the generate button
 GenCommand.Enabled = True
 'exit the sub
 Exit Sub
End If
'input data check is ok
'generate the task data
Call GenTask(BeginN, EndN, CountN, TimeOut)
'initialize the task staus list
Call InitTaskStList
End Sub

Private Sub ListenCommand_Click()
Rem event when listen button clicked
'prevent reload
ListenCommand.Enabled = False
'judge socket staus by caption
If ListenCommand.Caption = "监听" Then
'winsocket is not listenning
 'judge if the winsocket is closed
 If ws(0).State <> sckClosed Then
 'not closed
  'Close it
  ws(0).Close
  'release control
  DoEvents
 End If
 'set local port by textbox
 ws(0).LocalPort = ListenText.Text
 'listen now
 ws(0).Listen
 'add to log
 AddLog "监听开始"
 'change button caption
 ListenCommand.Caption = "停止"
Else
 'judge if the winsocket is closed
 If ws(0).State <> sckClosed Then
 'notclosed
  'close it
  ws(0).Close
  'release control
  DoEvents
 End If
 'change the button caption
 ListenCommand.Caption = "监听"
 'add to log
 AddLog "监听结束"
End If
'recover the button
ListenCommand.Enabled = True
End Sub

Private Sub SaveCommand_Click()
Rem event when click save button

'save the data to database
Call SavetoMDB
End Sub

Private Sub TaskStList_Click()
Rem event when click listbox

'judge if index is valid
If TaskStList.ListIndex >= 0 Then
'index is ok
 'judge the item status
 If TaskSt(TaskStList.ListIndex).Status = 3 Then
 'the task is finished
  'change result textbox
  ResultText.Text = TaskSt(TaskStList.ListIndex).Result
  'update label caption
  Label6.Caption = "PI值小数点后从第" + CStr(TaskSt(TaskStList.ListIndex).BeginPos * 8 - 7) + "位到" + CStr(TaskSt(TaskStList.ListIndex).EndPos * 8) + "位（十六进制）"
 Else
 'the task has no result yet
  'clear result textbox
  ResultText.Text = ""
 End If
End If
End Sub

Private Sub ws_Close(Index As Integer)
Rem event when remote winsocket is closing

'add to log
AddLog "Socket " + Str$(Index) + " 已关闭"
'close it
ws(Index).Close
End Sub

Private Sub ws_ConnectionRequest(Index As Integer, ByVal requestID As Long)
Rem event when client request a connection

Dim i As Integer, j As Integer
'judge if the index is 0 (listen winsocket)
If Index = 0 Then
'the index is ok
 'set a flag
 j = 0
 'loop to find a idle winsocket
 For i = 1 To SocketN
  'judge the winsocket is closed
  If ws(i).State = sckClosed Then
  'it is closed
   'set the socket number
   j = i
   'exit the loop
   Exit For
  End If
 Next i
 'judge if no idle winsocket
 If j = 0 Then
 'no idle winsocket
  'inc socket number
  SocketN = SocketN + 1
  'load a new control
  Load ws(SocketN)
  'set flag to new one
  j = SocketN
 End If
 'the selected winsocket accept the request
 ws(j).Accept requestID
 'add to log
 AddLog "Socket " + Str$(j) + " 已连接"
End If
End Sub

Private Sub ws_DataArrival(Index As Integer, ByVal bytesTotal As Long)
Rem event when received some data

Dim s As String, BackStr As String, BeginN As Long, EndN As Long, Result As String, s1 As String
Dim i As Long, j As Long
'get data from buffer
ws(Index).GetData s
'AddLog s
'judge the data
If s = "REQUEST" Then
'request a task
 'get task description string
 BackStr = GetTask
 'send data to client
 ws(Index).SendData BackStr
ElseIf Left$(s, 3) = "RES" Then
'a result is returning
 'get result
 'get split space position
 i = InStr(4, s, " ")
 'judge if the position is valid
 If i = 0 Or i > Len(s) Then
 'the position is invalid
  'close it
  Call CloseSocket(Index)
  Exit Sub
 End If
 'get begin position string
 s1 = Mid$(s, 4, i - 1 - 4 + 1)
 'convert to long
 BeginN = CLng(s1)
 j = i + 1
 'get another split space position
 i = InStr(i + 1, s, " ")
 'judge if the position is valid
 If i = 0 Or i > Len(s) Then
 'the position is invalid
  'close it
  Call CloseSocket(Index)
  Exit Sub
 End If
 'get the end position string
 s1 = Mid$(s, j, i - j)
 'convert to long
 EndN = CLng(s1)
 'get result string
 Result = Mid$(s, i + 1)
 'call check&storage routine
 Call ReceiveResult(BeginN, EndN, Result)
 
 'send a new task
 'get task description string
 BackStr = GetTask
 'send the data
 ws(Index).SendData BackStr
 'release the control
 DoEvents
 'judge if all task is finished
 If (BackStr = "NOTASK") And AllFinished And TaskN <> 0 Then
 'all finished
  'call process function
  Call DisplayResult
 End If
Else
'unknown command
 'ws(Index).Close
 'DoEvents
 'close it
 Call CloseSocket(Index)
End If
End Sub

Private Sub ws_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)
Rem event when winsocket error

'add to log
AddLog Description
'ws(Index).Close
'close it
Call CloseSocket(Index)
End Sub

Private Sub ws_SendComplete(Index As Integer)
Rem event when data is sent

'close it
Call CloseSocket(Index)
'ws(Index).Close
'DoEvents
End Sub