我的拨号程序是用VB写的，
关于这个程序，你一看就明白，你自己写成DELPHI的吧！
有什么问题，给我发MAIL
你可以参考，看完别忘了给我加分噢！
Option Explicit
Dim pack_num
Dim data_reactive$
Dim tel_num As String
Function dial_init() As Integer
Dim succ, i, start
Dim data_re$
succ = False
For i = 0 To 10
data_re$ = ""
mscomm1.InBufferCount = 0
mscomm1.Output = Chr$(13) + "ATQ0V1E1S0=0" + Chr$(13)
start = Timer
Do While Timer - start < 3.2
If mscomm1.InBufferCount Then
data_re$ = data_re$ + mscomm1.Input
If InStr(data_re$, "OK") Then
dial_init = 0
Exit Function
End If
End If
Loop
Next i
dial_init = 1
End Function
Function dela(ByVal i As Single) As Integer
Dim start As Single
start = Timer
Do While Timer - start < i
Loop
dela = 0
End Function
Function dial_t(ByVal Number As String) As Integer
Dim dialstring$
Dim start, rn, i
rn = dial_init()
If rn <> 0 Then
dial_t = 20
Form60.Caption = "dial init fail!"
Exit Function
Else
Form60.Caption = "dial init ok"
End If
rn = dela(1)
dialstring$ = Chr$(13) + "ATDP" + Form2.Text1.Text + Chr$(13)
mscomm1.Output = dialstring$
rn = dela(5)
data_reactive$ = ""
mscomm1.InBufferCount = 0
For i = 1 To 30
rn = dela(1)
Form60.Caption = Str(i)
If mscomm1.InBufferCount Then
data_reactive$ = data_reactive$ + mscomm1.Input
If InStr(data_reactive$, "CONNECT 2400") Then
dial_t = 0
txtconnect.Text = "建立（2400）"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "OK") Then
dial_t = 1
txtconnect.Text = "命令态"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "RING") Then
dial_t = 2
txtconnect.Text = "ring"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "CONNECT 1200") Then
dial_t = 0
txtconnect.Text = "connect 1200"
Exit Function
Else
If InStr(data_reactive$, "CONNECT 4800") Then
dial_t = 0
txtconnect.Text = "connect 4800"
Exit Function
Else
If InStr(data_reactive$, "CONNECT 9600") Then
dial_t = 0
txtconnect.Text = "connect 9600"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "CONNECT 19200") Then
dial_t = 0
txtconnect.Text = "connect 19200"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "CONNECT 33600") Then
dial_t = 0
txtconnect.Text = "connect 33600"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "NO CARRIER") Then
dial_t = 3
txtconnect.Text = "没有检测到远端载波"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "ERROR") Then
dial_t = 4
txtconnect.Text = "命令错"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "NO DIALTONE") Then
dial_t = 5
txtconnect.Text = "无拨号音"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "BUSY") Then
dial_t = 6
txtconnect.Text = "占线"
txtwait.Text = " "
Exit Function
Else
If InStr(data_reactive$, "NO ANSWER") Then
dial_t = 8
txtconnect.Text = "no answer"
txtwait.Text = " "
Exit Function
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
Next i
dial_t = 21
Form60.Caption = "fail at line"
End Function
Function hangup() As Integer
Dim start, rn, i
Dim data_re$
For i = 1 To 10
data_re$ = " "
mscomm1.InBufferCount = 0
rn = dela(2)
mscomm1.Output = "+++"
rn = dela(2)
mscomm1.Output = "ATH" + Chr$(13) + Chr$(10)
start = Timer
Do While Timer - start < 4
If mscomm1.InBufferCount Then
data_re$ = data_re$ + mscomm1.Input
If InStr(data_re$, "OK") Then
hangup = 0
txtstatus.Text = "挂机"
Exit Function
End If
End If
Loop
Next i
hangup = 1
End Function
Function init_modem() As Integer
Dim dummy
Dim data_re$
Dim i, succ, start
On Error Resume Next
mscomm1.PortOpen = True
If Err Then
init_modem = 1
Exit Function
End If
mscomm1.Settings = "9600,N,8,1"
mscomm1.InBufferCount = 0
mscomm1.OutBufferCount = 0
mscomm1.InputLen = 0
succ = False
For i = 0 To 10
data_re$ = " "
mscomm1.InBufferCount = 0
mscomm1.Output = Chr$(13) + "ATZ" + Chr$(13)
start = Timer
Do While Timer - start < 3.2
If mscomm1.InBufferCount Then
data_re$ = data_re$ + mscomm1.Input
If InStr(data_re$, "OK") Then
succ = True
Exit For
End If
End If
Loop
Next i
If succ = False Then
init_modem = 2
mscomm1.PortOpen = False
Exit Function
End If
succ = False
For i = 0 To 10
data_re$ = " "
mscomm1.InBufferCount = 0
mscomm1.Output = Chr$(13) + "ATQ0V1E1S0=0" + Chr$(13)
start = Timer
Do While Timer - start < 2.2
If mscomm1.InBufferCount Then
data_re$ = data_re$ + mscomm1.Input
If InStr(data_re$, "OK") Then
succ = True
Form60.Caption = "reset ok"
Exit For
End If
End If
Loop
Next i
If succ = False Then
init_modem = 3
mscomm1.PortOpen = False
Exit Function
End If
init_modem = 0
End Function
Function rece_data(ByVal Number As String)
Dim data_rece$
Dim start, rn, dummy, nak_number
Dim crcdata$
Dim goon, re_flag
Dim normal_end
Dim rece_flag
pack_num = 0
rn = dial_t(Form2.Text1.Text)
txtstatus = "handing"
If rn <> 0 Then
rece_data = 1
Exit Function
End If
goon = True
normal_end = True
rece_flag = 0
nak_number = 0
Do
dummy = DoEvents()
mscomm1.Output = Chr$(21)
nak_number = nak_number + 1
If nak_number > 3 Then
normal_end = False
goon = False
End If
mscomm1.InBufferCount = 0
start = Timer
Do While Timer - start < 2
If mscomm1.InBufferCount >= 133 Then
rece_flag = 1
Exit Do
End If
Loop
start = Timer
If rece_flag = 1 And goon = True Then
rece_flag = 0
nak_number = 0
Do
dummy = DoEvents()
data_rece$ = mscomm1.Input
'show_text2 (data_rece$)
text2.Text = text2.Text + Mid(data_rece$, 1, 122)
Open "c:/t.txt" For Output As #1
Close #1
If Len(Trim(data_rece$)) > 0 Then
rn = 0
End If
rn = 0
If Mid(data_rece$, 1, 1) = Chr$(4) And rn = 0 Then
mscomm1.Output = Chr(24)
pack_num = pack_num + 1
normal_end = True
goon = True '原为false
txtstatus.Text = "结束"
Exit Do
End If
If Mid(data_rece$, 1, 1) = Chr$(24) Then
normal_end = False
goon = True '原为false
txtstatus.Text = "abort"
Exit Do
End If
If Mid(data_rece$, 1, 1) = Chr$(1) And rn = 0 Then
txtstatus.Text = "confirm"
mscomm1.Output = Chr$(6)
pack_num = pack_num + 1
nak_number = 0
mscomm1.InBufferCount = 0
re_flag = False
start = Timer
Do While Timer - start < 2
If mscomm1.InBufferCount >= 10 Then
re_flag = True
Exit Do
End If
Loop
If re_flag = False Then
Exit Do
End If
Else
End If
Loop
End If
Loop While goon = True
If normal_end = False Then
txtstatus.Text = "unnormal"
mscomm1.Output = Chr$(24)
End If
Close
End Function
Private Sub Command1_Click()
Dim rn, dummy
Dim i As Long
i = 0
If init_modem() <> 0 Then
txtconnect.Text = "modem bad"
rn = dela(3)
End
Else
txtconnect.Text = "modem status normal"
End If
rn = rece_data("20")
rn = hangup()
rn = dela(3)
mscomm1.PortOpen = False
End Sub
Private Sub Command2_Click()
Dim hn
hn = hangup()
End Sub
Private Sub Command3_Click()
formsee.Show
End Sub
Private Sub Form_Activate()
Label1.Caption = "接收到的数据"
txtconnect.Text = " "
txtstatus.Text = " "
txtwait.Text = " "
Text1.Text = Form2.Text1.Text
End Sub
Private Sub show_text2(data_rece$)
Dim chrl, chrr As Integer
Dim ch$
Dim i%
Dim text_2 As String
text_2$ = "收到字节数="
text_2$ = text_2$ + Str(Len(data_rece$)) + Chr(13) + Chr(10)
text_2$ = text_2$ + Mid(data_rece$, 1, 5) + Chr(13) + Chr(10) + "日期："
For i% = 6 To 9
ch$ = Mid(data_rece$, i%, 1)
chrl = (Asc(ch$) And &HF0) / 16
chrr = Asc(ch$) And &HF
text_2$ = text_2$ + Chr$(chrl + 48) + Chr$(chrr + 48)
Next i%
text_2$ = text_2$ + Chr(13) + Chr(10) + "前半包数据："
For i% = 10 To 57
ch$ = Mid(data_rece$, i%, 1)
chrl = (Asc(ch$) And &HF0) / 16
If chrl < 10 Then
text_2$ = text_2$ + Chr$(chrl + 48)
Else
text_2$ = text_2$ + Chr$(chrl + 55)
End If
chrr = Asc(ch$) And &HF
If chrr < 10 Then
text_2$ = text_2$ + Chr$(chrr + 48)
Else
text_2$ = text_2$ + Chr$(chrr + 55)
End If
Next i%
text_2$ = text_2$ + Chr(13) + Chr(10)
text_2$ = text_2$ + Mid(data_rece$, 58, 10) + Chr(13) + Chr(10)
text_2$ = text_2$ + Mid(data_rece$, 68, 2) + Chr(13) + Chr(10) + "日期："
For i% = 70 To 73
ch$ = Mid(data_rece$, i%, 1)
chrl = (Asc(ch$) And &HF0) / 16
chrr = Asc(ch$) And &HF
text_2$ = text_2$ + Chr$(chrl + 48) + Chr$(chrr + 48)
Next i%
text_2$ = text_2$ + Chr(13) + Chr(10) + "后半包数据："
For i% = 74 To 121
ch$ = Mid(data_rece$, i%, 1)
chrl = (Asc(ch$) And &HF0) / 16
If chrl < 10 Then
text_2$ = text_2$ + Chr$(chrl + 48)
Else
text_2$ = text_2$ + Chr$(chrl + 55)
End If
chrr = Asc(ch$) And &HF
If chrr < 10 Then
text_2$ = text_2$ + Chr$(chrr + 48)
Else
text_2$ = text_2$ + Chr$(chrr + 55)
End If
Next i%
text_2$ = text_2$ + Chr(13) + Chr(10)
text_2$ = text_2$ + Mid(data_rece$, 122, 10) + Chr(13) + Chr(10)
text_2$ = text_2$ + "CRC校验：" + Chr(13) + Chr(10)
For i% = 132 To 133
ch$ = Mid(data_rece$, i%, 1)
chrl = (Asc(ch$) And &HF0) / 16
If chrl < 10 Then
text_2$ = text_2$ + Chr$(chrl + 48)
Else
text_2$ = text_2$ + Chr$(chrl + 55)
End If
chrr = Asc(ch$) And &HF
If chrr < 10 Then
text_2$ = text_2$ + Chr$(chrr + 48)
Else
text_2$ = text_2$ + Chr$(chrr + 55)
End If
Next i%
text2.Text = text_2$ + Chr(13) + Chr(10)
End Sub
Public Function rece(ByVal Number As String)
Dim data_rece$
Dim start, rn, dummy, nak_number
Dim goon, re_flag
Dim normal_end
Dim rece_flag
pack_num = 0
rn = dial_t(Text1.Text)
txtstatus = "handing"
If rn <> 0 Then
rece_data = 1
Exit Function
End If
goon = True
normal_end = True
rece_flag = 0
nak_number = 0
Do
dummy = DoEvents()
mscomm1.Output = Chr$(21)
nak_number = nak_number + 1
If nak_number > 3 Then
normal_end = False
goon = False
End If
mscomm1.InBufferCount = 0
start = Timer
Do While Timer - start < 2
If mscomm1.InBufferCount >= 133 Then
rece_flag = 1
Exit Do
End If
Loop
start = Timer
If rece_flag = 1 And goon = True Then
rece_flag = 0
nak_number = 0
Do
dummy = DoEvents()
data_rece$ = mscomm1.Input
'show_text2 (data_rece$)
text2.Text = Mid(data_rece$, 3, 131)
If Len(Trim(data_rece$)) > 0 Then
rn = 0
End If
rn = 0
If Mid(data_rece$, 131, 1) = Chr$(4) And rn = 0 Then
mscomm1.Output = Chr(24)
pack_num = pack_num + 1
normal_end = True
goon = False
txtstatus.Text = "结束"
Exit Do
End If
If Mid(data_rece$, 1, 1) = Chr$(24) Then
normal_end = False
goon = False
txtstatus.Text = "abort"
Exit Do
End If
If Mid(data_rece$, 1, 1) = Chr$(1) And rn = 0 Then
txtstatus.Text = "confirm"
mscomm1.Output = Chr$(6)
pack_num = pack_num + 1
nak_number = 0
mscomm1.InBufferCount = 0
re_flag = False
start = Timer
Do While Timer - start < 2
If mscomm1.InBufferCount >= 133 Then
re_flag = True
Exit Do
End If
Loop
If re_flag = False Then
Exit Do
End If
Else
End If
Loop
End If
Loop While goon = True
If normal_end = False Then
txtstatus.Text = "unnormal"
mscomm1.Output = Chr$(24)
End If
Close
End Function
