Visual Basic 6.0 求助~urgent!!!

funfun

大家帮帮忙，小妹现在做着一个project（low cost infrared modem）需要用到visual basic 6~
我的hardware是用usb serial port，所以一插进电脑就是detect在COM4或以上~
如果我要把这个software换成automatic detect serial port,那么我应该改哪里的code?
我用过if statement,可是还是行不通~
问了很多老师和朋友，他们都没时间帮我，有些老师也搞不清楚状况~
他们说vb6太久了，很多都忘记了~
刚刚问了一个朋友，他叫我来这边问~
请大家帮帮我，我明天就要交货了~

以下就是original code~

'program default
Dim startTime As Date
Dim programName As String

'for file transfer
Dim cancelButton As Boolean
Dim sendFileName As String
Dim sendingFile As Boolean

'for receiving file
Dim receiveFileStatus As Boolean
Dim receiveFileName As String

'for receiving text
Dim varRX2 As String
Dim lastReceived As Date
Dim startIdle As Date

'for 555 timer simulation
Dim receiverOn As Boolean
Dim timer5Counter As Integer

Dim send_Frame As Integer

'Dim NAK_text As String

Private Sub advance_connect_Click()
On Error GoTo eventerrorsac
MSComm1.PortOpen = True

eventerrorsac:
If Err.Number = 8005 Then
MsgBox ("Port is already open.")
connectedMode_settings
End If
End Sub

Private Sub advance_Debug_Click()
'##############
'debugging mode
'##############
If advance_Debug.Checked Then
advance_Debug.Checked = False
StatusBar1.Panels(3).Text = ""
RichTextBox1.BackColor = &H80000005
Else
advance_Debug.Checked = True
StatusBar1.Panels(3).Text = "Debug Mode"
RichTextBox1.BackColor = &H80000018
End If

End Sub


Private Sub advance_disconnect_Click()
On Error GoTo eventerrorsad

MSComm1.PortOpen = False

eventerrorsad:
If Err.Number = 8012 Then
MsgBox ("Port is not open.")
disconnectedMode_settings
End If
End Sub

Private Sub Command1_Click()
'dont send if empty
If Text2.Text = "" Then
Exit Sub
Else

'insert input to outputbox
RichTextBox1.Text = RichTextBox1.Text + "me:  " + Text2.Text + vbNewLine
RichTextBox1.SelLength = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)

'sends the data
'NAK_text = Text2.Text

MSComm1.OutBufferCount = 0

Command1.Enabled = False

transmitChar (Text2.Text)


MSComm1.Output = Chr(4)

Command1.Enabled = True

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

receiverOn = True

'clear input box
Text2.Text = ""

Text2.SetFocus

End If
End Sub

Private Sub Command2_Click()
file_connect_Click
End Sub

Private Sub Command3_Click()
file_disconnect_Click
End Sub

Private Sub Command4_Click()
'reset settings to default
Combo1.Text = "COM1"
Combo2.Text = 2400
Combo4.Text = "None"
End Sub

Private Sub Exit_Click()
Unload Form1
End Sub

Private Sub file_connect_Click()

'check if port is open
If MSComm1.PortOpen Then

'prompt user that port is open
If MsgBox("Selected port is open, press OK to reconnect with new settings. CANCEL to resume current connection.", vbOKCancel, "Reminder") = vbCancel Then

'press cancel to resume previous connection

connectedMode_settings
StatusBar1.Panels(3).Text = "Port Used in other Terminal."

Else
'press ok to reconnect
MSComm1.PortOpen = False

'open port
startConnection_function

End If

Else
'port is close and now will open
startConnection_function
End If

End Sub

Private Sub file_disconnect_Click()
On Error GoTo eventerrorsfd

'close port
MSComm1.PortOpen = False

'stop timer
Timer1.Enabled = False

disconnectedMode_settings
Command2.SetFocus

eventerrorsfd:
If Err.Number = 8012 Then
MsgBox ("Port is not open.")
disconnectedMode_settings
End If
End Sub

Private Sub Form_Load()

'set port settings to default value
Form1.Command4 = True

'set default
programName = "CMessenger"
Form1.Caption = programName

RichTextBox1.Text = ""
Text2.Text = ""

send_Frame = 1
Text1.Text = send_Frame

'uncheck menu
advance_Debug.Checked = False
frame_2.Checked = False
frame_3.Checked = False
frame_4.Checked = False
frame_5.Checked = False

varRX2 = "him: "

'enable n disable
received_cancel.Enabled = False
receiverOn = True
receiveFileStatus = False
sendingFile = False
disconnectedMode_settings
End Sub

Private Sub Form_Resize()

On Error Resume Next
'set minimum form size
If Form1.Width < 7710 Then
Form1.Width = 7710
End If

If Form1.Height < 6345 Then
Form1.Height = 6345
End If

'hort alignment
Frame1.Left = Form1.Width - Frame1.Width - 200
Command2.Left = Frame1.Left + Frame1.Width - Command2.Width - 100
Command3.Left = Command2.Left
RichTextBox1.Width = Form1.Width - Frame1.Width - 400
RichTextBox1.Left = 100
Command1.Left = RichTextBox1.Left + RichTextBox1.Width - Command1.Width
Text2.Width = RichTextBox1.Width - Command1.Width - 100
Text2.Left = 100
StatusBar1.Panels(3).Width = Form1.Width - StatusBar1.Panels(1).Width - StatusBar1.Panels(2).Width - 200
Image1.Left = Frame1.Left + 100

'vert alignment
RichTextBox1.Top = 100 + Toolbar1.Height
Frame1.Top = 100 + Toolbar1.Height
Command2.Top = Frame1.Top + Frame1.Height + 100
Command3.Top = Command2.Top
RichTextBox1.Height = Form1.Height - 375 - 540 - 1200 - Text2.Height
Command1.Top = RichTextBox1.Top + RichTextBox1.Height + 100
Text2.Top = Command1.Top
Image1.Top = Command2.Top + Command2.Height + 100
End Sub

Private Sub Form_Unload(Cancel As Integer)
If RichTextBox1.Text = "" Then
ElseIf MsgBox("Do you want to save your conversation?", vbYesNo, programName) = vbYes Then
received_save_Click
End If

If MSComm1.PortOpen Then
MsgBox "Port not close, press OK to close.", vbOKOnly, "Reminder"
MSComm1.PortOpen = False
End If
End Sub


Private Sub frame_1_Click()
frame_2.Checked = False
frame_3.Checked = False
frame_4.Checked = False
frame_5.Checked = False
send_Frame = 1
Text1.Text = send_Frame
End Sub

Private Sub frame_2_Click()
frame_1.Checked = False
frame_2.Checked = True
frame_3.Checked = False
frame_4.Checked = False
frame_5.Checked = False
send_Frame = 2
Text1.Text = send_Frame
End Sub

Private Sub frame_3_Click()
frame_1.Checked = False
frame_2.Checked = False
frame_3.Checked = True
frame_4.Checked = False
frame_5.Checked = False
send_Frame = 3
Text1.Text = send_Frame
End Sub

Private Sub frame_4_Click()
frame_1.Checked = False
frame_2.Checked = False
frame_3.Checked = False
frame_4.Checked = True
frame_5.Checked = False
send_Frame = 4
Text1.Text = send_Frame
End Sub

Private Sub frame_5_Click()
frame_1.Checked = False
frame_2.Checked = False
frame_3.Checked = False
frame_4.Checked = False
frame_5.Checked = True
send_Frame = 5
Text1.Text = send_Frame
End Sub


*接第二贴~

funfun

Private Sub MSComm1_OnComm()

Select Case MSComm1.CommEvent

Case Is > 1000
'disable Timer2
Timer2.Enabled = False

'receiving codes
MSComm1.InBufferCount = 0

Case comEvReceive And MSComm1.InBufferCount > 0

varrx = MSComm1.Input
MSComm1.InBufferCount = 0

'reply NAK when receive
'If varrx = Chr(21) Then
'transmitChar (NAK_text)
'End If

'#################
'WHEN SENDING FILE
'#################
If sendingFile = True Then
'if received denied

Select Case varrx
'check for file transfer accept
Case Chr(18)
RichTextBox1.Text = RichTextBox1.Text + "File Transfer Request Accepted." + vbNewLine

sendFile_function (sendFileName)

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

MSComm1.Output = Chr(4)
sendingFile = False

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

Exit Sub

Case Chr(19)
received_cancel_Click
RichTextBox1.Text = RichTextBox1.Text + "File Transfer Request Declined." + vbNewLine
Exit Sub

Case Else
Exit Sub

End Select
End If

'###################
'WHEN RECEIVING FILE
'###################
'check receiving file
If receiveFileStatus = True Then
If varrx = Chr(4) Then
'close the transmittingfile command
RichTextBox1.Text = RichTextBox1.Text + "Received File Saved In " + receiveFileName + vbNewLine
receiveFileStatus = False
Toolbar1.Buttons("sendfile").Enabled = True
Toolbar1.Buttons("cancel").Enabled = False
received_sendfile.Enabled = True
received_cancel.Enabled = False
Exit Sub

'receiver cancel the transmission
ElseIf varrx = Chr(19) Then
received_cancel_Click

Else
Open receiveFileName For Binary Access Write As #1
Put #1, , varrx
Close #1

'show progress
RichTextBox1.Text = RichTextBox1.Text + "#"
Exit Sub
End If
End If

'################################
'WHEN RECEIVER IS ABLE TO RECEIVE
'################################

If receiverOn = True Or advance_Debug.Checked = True Then

Select Case varrx

'when receive an EOF
Case Chr(4)
RichTextBox1.Text = RichTextBox1.Text + vbNewLine
varRX2 = "him: "

'check for file transfer request
Case Chr(17)
If MsgBox("Accept Incoming File Transfer?", vbYesNo) = vbYes Then
saveFileRequest
RichTextBox1.Text = RichTextBox1.Text + "Accepted File Transfer Request." + vbNewLine
Else
RichTextBox1.Text = RichTextBox1.Text + "Declined File Transfer Request." + vbNewLine
MSComm1.Output = Chr(19)
End If

'display input as text
Case Else

varRX2 = varRX2 + varrx
RichTextBox1.Text = RichTextBox1.Text + varRX2
varRX2 = ""

End Select
End If

'time of the last data received
lastReceived = Time

'start idle countdown
Timer2.Enabled = True
startIdle = Now

End Select

RichTextBox1.SelLength = 0
RichTextBox1.SelLength = Len(RichTextBox1.Text)


End Sub

Private Sub New_Click()
ret = Shell(App.Path & "\Project1.exe" & FileSelect$, vbHide)
End Sub

Private Sub received_cancel_Click()
Toolbar1.Buttons("cancel").Enabled = False
Toolbar1.Buttons("sendfile").Enabled = True
received_cancel.Enabled = False
received_sendfile.Enabled = True

receiveFileStatus = False
cancelButton = True
End Sub

Private Sub received_clear_Click()

If RichTextBox1.Text = "" Then
ElseIf MsgBox("Do you want to save your conversation?", vbYesNo, programName) = vbYes Then
received_save_Click
End If

RichTextBox1.Text = ""
Text2.SetFocus
End Sub

Private Sub received_open_Click()
On Error Resume Next
'choose file
CommonDialog1.DialogTitle = "Open file"
CommonDialog1.Filter = "Rich Text Format (*.rtf)|*.rtf"
CommonDialog1.FileName = ""
CommonDialog1.ShowOpen

'check whether got choose or not
If CommonDialog1.FileName <> "" Then
RichTextBox1.LoadFile (CommonDialog1.FileName)
StatusBar1.Panels(3).Text = "File loaded from " + CommonDialog1.FileName
End If
End Sub

Private Sub received_Print_Click()
Printer.Print RichTextBox1.Text
Printer.EndDoc
End Sub

Private Sub received_save_Click()
On Error Resume Next
'open dialog box
CommonDialog1.DialogTitle = "Saving conversation"
CommonDialog1.Filter = "Rich Text Format (*.rtf)|*.rtf"
CommonDialog1.ShowSave

If CommonDialog1.FileName <> "" Then
RichTextBox1.SaveFile (CommonDialog1.FileName)
StatusBar1.Panels(3).Text = "File saved to " + CommonDialog1.FileName
End If


End Sub



Private Sub received_sendfile_Click()

'choose file
CommonDialog1.DialogTitle = "Choose File To Send"
CommonDialog1.Filter = "All Files (*.*)|*.*"
CommonDialog1.ShowOpen

'check whether got choose file or not
If CommonDialog1.FileName <> "" Then

'enable n disable
Toolbar1.Buttons("cancel").Enabled = True
Toolbar1.Buttons("sendfile").Enabled = False
received_cancel.Enabled = True
received_sendfile.Enabled = False

'load file name into memory
sendFileName = CommonDialog1.FileName
RichTextBox1.Text = RichTextBox1.Text + "Requesting for File Transfer." + vbNewLine

'unique word
MSComm1.Output = Chr(17)
sendingFile = True
End If
End Sub

Private Sub Text2_Change()
Command1.Default = True
End Sub


Private Sub Timer1_Timer()
StatusBar1.Panels(1).Text = "connected for " & Format(Now - startTime, "hh:nn:ss")
End Sub

Private Sub startConnection_function()
Dim mintCom As Integer
Dim portRate As Integer
Dim parityUsed As String

On Error GoTo eventerrors

' port setting details
If Combo1.Text = "COM2" Then
mintCom = 2
Else
mintCom = 1
End If

portRate = Int(Combo2.Text)

'set parity
If Combo4.Text = "Even" Then
parityUsed = "E"
ElseIf Combo4.Text = "Odd" Then
parityUsed = "O"
Else
parityUsed = "N"
End If

'initiate com port

MSComm1.CommPort = mintCom

MSComm1.Settings = portRate & ", " & parityUsed & ",8,1"
MSComm1.PortOpen = True

'start timer1 for status bar
startTime = Now
Timer1.Enabled = True

connectedMode_settings

StatusBar1.Panels(2).Text = "settings: " & "COM" & MSComm1.CommPort & " " & MSComm1.Settings

Text2.SetFocus


Form1.Caption = programName & " - Connected"

'on error
eventerrors:

If Err.Number = 8002 Then
    MsgBox "Invalid port number. Please select another port number.", vbOKOnly, "Error"
    Combo1.SetFocus
    Exit Sub
ElseIf Err.Number = 8005 Then
MsgBox "Port is open. Please select another port.", vbOKOnly, "Error"
ElseIf Err.Number = 68 Then
    MsgBox "Cannot Open COM Port", vbOKOnly, "Error"
    Exit Sub

End If

End Sub

Private Sub Timer2_Timer()
If Format(Now - startIdle, "hh:nn") = "00:00" Then
StatusBar1.Panels(3).Text = "Last received on " & lastReceived & "."
Else
StatusBar1.Panels(3).Text = "Last received on " & lastReceived & ". Idle for " & Format(Now - startIdle, "hh:nn")
End If
End Sub


Private Sub Timer5_Timer()
If timer5Counter < 2 Then
timer5Counter = timer5Counter + 1
Else
Timer5.Enabled = False
End If
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "sendfile"
received_sendfile_Click

Case "cancel"
received_cancel_Click

Case "clear"
received_clear_Click

Case "open"
received_open_Click

Case "save"
received_save_Click

Case "print"
received_Print_Click

End Select
End Sub

Private Sub sendFile_function(tmp$)
Dim temp$
Dim hsend, bsize, LF&

'show state
RichTextBox1.Text = RichTextBox1.Text + "File Transmission Started..." + vbNewLine

'disable buttons
Command3.Visible = False
Command1.Enabled = False

' Open file
Open tmp$ For Binary Access Read As #2
' Check size on Mscomm1 OutBuffer
bsize = MSComm1.OutBufferSize
' Check file length
LF& = LOF(2)

' This code makes tiny pieces of data (Buffer sized)
' And send's it

Do Until EOF(2) Or cancelButton
   
    If LF& - Loc(2) <= bsize Then
        bsize = LF& - Loc(2) + 1
    End If

    ' Make room for some data
    temp$ = Space$(bsize)
   
    ' Put the data piece in the Temp$ string
    Get #2, , temp$
   
    MSComm1.Output = temp$
    'show progress
RichTextBox1.Text = RichTextBox1.Text + "#"

Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop
    Do
        ret = DoEvents()
    ' Wait until the buffer is empty
    Loop Until MSComm1.OutBufferCount = 0
Loop

' close file
Toolbar1.Buttons("cancel").Enabled = False
Close #2

'show transmission finish and enable buttons
If cancelButton Then
RichTextBox1.Text = vbNewLine + RichTextBox1.Text + "File Transmission Cancelled!!!" + vbNewLine
Else
RichTextBox1.Text = vbNewLine + RichTextBox1.Text + "File Transmission Completed!!!" + vbNewLine
End If

'enable n disable
cancelButton = False
Command3.Visible = True
Command1.Enabled = True
Toolbar1.Buttons("cancel").Enabled = False
Toolbar1.Buttons("sendfile").Enabled = True
received_cancel.Enabled = False
received_sendfile.Enabled = True

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

End Sub

Private Sub connectedMode_settings()
Command2.Visible = False
Command4.Enabled = False
Combo1.Enabled = False
Combo2.Enabled = False
Combo4.Enabled = False
file_connect.Enabled = False
file_disconnect.Enabled = True

Command1.Enabled = True
Command3.Visible = True
Toolbar1.Buttons("sendfile").Enabled = True


End Sub

接第三贴~

[ 本帖最后由 funfun 于 17-9-2009 04:06 AM 编辑 ]

funfun

Private Sub disconnectedMode_settings()
'rename
Form1.Caption = programName + " - Disonnected"
StatusBar1.Panels(1).Text = "disconnected"
StatusBar1.Panels(2).Text = ""

'disable
Command3.Visible = False
Command1.Enabled = False
Toolbar1.Buttons("sendfile").Enabled = False
Toolbar1.Buttons("cancel").Enabled = False

'enable port settings
Command2.Visible = True
Command4.Enabled = True
Combo1.Enabled = True
Combo2.Enabled = True
Combo4.Enabled = True
file_connect.Enabled = True
file_disconnect.Enabled = False

End Sub

Private Sub saveFileRequest()
On Error Resume Next

'open dialog box
CommonDialog1.DialogTitle = "Choose Destination to Save File"
CommonDialog1.Filter = "All Files (*.*)|*.*"
CommonDialog1.ShowSave

receiveFileName = CommonDialog1.FileName

If receiveFileName <> "" Then
'on receive file status
receiveFileStatus = True
Toolbar1.Buttons("sendfile").Enabled = False
Toolbar1.Buttons("cancel").Enabled = True
received_cancel.Enabled = True
received_sendfile.Enabled = False

'send accept signal
MSComm1.Output = Chr(18)
Else
MSComm1.Output = Chr(19)
receiveFileStatus = False
End If

End Sub

Private Sub transmitChar(inputString)
Dim outputString As String
Dim stringPointer As Integer

receiverOn = False

For stringPointer = 1 To Len(inputString) Step send_Frame

outputString = Mid(inputString, stringPointer, send_Frame)
MSComm1.Output = outputString

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

Next

timer5Counter = 1
Timer5.Enabled = True
Do While Timer5.Enabled = True
DoEvents
Loop

End Sub

TSHsoft

好长噢。。。如果你把project zip了上传，还比较容易看哦。不过你应该已经解决问题了吧！

funfun

哈哈~问题解决了~
不好意思啊~