全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:865
推到 Plurk!
推到 Facebook!

VB轉換BCB語法問題請教

尚未結案
eric2339
一般會員


發表:21
回覆:14
積分:7
註冊:2007-11-27

發送簡訊給我
#1 引用回覆 回覆 發表時間:2012-03-18 16:07:25 IP:114.44.xxx.xxx 訂閱
由於小弟對vb涉及不深,想請問是否有高手可以協助轉換成BCB的語言呢?感謝!
[code vb]
Dim strLocalHost As String
Dim strLocalPort As Integer
Dim strRemoteHost As String
Dim strRemotePort As Integer
'
Dim FinsTcpHeader As String
Dim FinsTcpLength As String
Dim FinsTcpCommand As String
Dim FinsTcpErrorCode As String
Dim ClientNodeAddress As String
Dim ServerNodeAddress As String
Dim hexClientNodeAddress As String
Dim FinsFrame As String
'
Dim strSendData As String
Dim strSendDataLine As String
Dim strSendDataMonitor As String
Dim strReceiveData As String
Dim strReceiveDataMonitor As String
Dim strSocketStatus As String
Dim i, j As Integer
Dim intSocketStatus As String
Dim C5 As String
Dim C6 As String
Private Sub Command6_Click()
Dim sec1 As Integer
Command3.Enabled = False
Command5.Enabled = False
If Text22.Text < 5 Then
sec1 = 500
Else
sec1 = Text22.Text * 100
End If
Timer1.Interval = sec1
Timer1.Enabled = True
C6 = 1
Command6.Enabled = False
Text22.Text = sec1 / 100
End Sub
Private Sub Command7_Click()
Command3.Enabled = True
Command5.Enabled = True
Timer1.Enabled = False
C6 = 0
Command6.Enabled = True
End Sub
Private Sub Timer1_Timer()
Dim Rec_m As String
Dim Ch_text As String
Dim vv As String
Text23.Text = ""
Rec_m = ""
'--- TCP(Winsock)資料送信內容
strReceiveDataMonitor = ""
FinsTcpHeader = "46494E53"
FinsTcpLength = "0000001A"
FinsTcpCommand = "00000002"
FinsTcpErrorCode = "00000000"
ICF$ = "80"
RSV$ = "00"
GCT$ = "02"
DNA = "00" '......網路層
DA1 = "00" '......PLC NODE NUMBER
DA2 = "00"
SNA = "00" '......網路層
SA1 = "00" '......PC NODE NUMBER
SA2 = "00"
SID = "00"
vv = Text16.Text
Ch_text = Hex(Val(Text16.Text)) ' 10進制轉16進製
L = Len(Ch_text)
Select Case L
Case 0
Ch_text = "0000"
Case 1
Ch_text = "000" & Ch_text
Case 2
Ch_text = "00" & Ch_text
Case 3
Ch_text = "0" & Ch_text
Case Else
Ch_text = Ch_text
End Select
FCOMM = "010182" & Ch_text & "000005" '......FINSCOMMAND
FinsFrame = ICF$ RSV$ GCT$ DNA DA1 DA2 SNA & hexClientNodeAddress SA2 SID FCOMM
strSendData = FinsTcpHeader & _
FinsTcpLength & _
FinsTcpCommand & _
FinsTcpErrorCode & _
FinsFrame
Call SendData(strSendData)
End Sub
Private Sub Form_Load()
C5 = 0
C6 = 0
'--- Local Host IP Address 獲得 ---
strLocalHost = Winsock1.LocalIP
strLocalPort = "0"
ClientNodeAddress = "00"
Text1.Text = "192.168.250.2"
Text2.Text = strLocalPort
Text3.Text = ClientNodeAddress
Text23.Text = ""
'--- Winsock Parameter 初期設定 ---
Text4.Text = "192"
Text5.Text = "168"
Text6.Text = "250"
Text7.Text = "1"
Text8.Text = "9600"
strRemoteHost = Text4.Text & "." & Text5.Text & "." & Text6.Text & "." & Text7.Text
strRemotePort = Text8.Text
Winsock1.Protocol = sckTCPProtocol
Winsock1.LocalPort = strLocalPort
Winsock1.RemoteHost = strRemoteHost
Winsock1.RemotePort = strRemotePort
Call SocketStatus
End Sub
Private Sub Command1_Click() '..............先與PLC做連線,下連線碼
Dim DebugLoop As Long
If Winsock1.State > 0 Then
Winsock1.Close
Call SocketStatus
'--- 被斷訊為止待機
Do While Not (Winsock1.State = sckClosed)
DoEvents
Call SocketStatus
Loop
End If
'--- Winsock Parameter 初期設定 ---
strRemoteHost = Text4.Text & "." & Text5.Text & "." & Text6.Text & "." & Text7.Text
strRemotePort = Text8.Text
Winsock1.Protocol = sckTCPProtocol
Winsock1.LocalPort = strLocalPort
Winsock1.RemoteHost = strRemoteHost
Winsock1.RemotePort = strRemotePort
Winsock1.Close
'--- Socket Open ---
Winsock1.Connect
'--- 連結或斷訊為止之待機 ---
Do While (Winsock1.State > 0 And Winsock1.State < 7)
DoEvents
DebugLoop = DebugLoop 1
Call SocketStatus
Loop
FinsTcpHeader = "46494E53"
FinsTcpLength = "0000000C"
FinsTcpCommand = "00000000"
FinsTcpErrorCode = "00000000"
ClientNodeAddress = "00000000"
strSendData = FinsTcpHeader & _
FinsTcpLength & _
FinsTcpCommand & _
FinsTcpErrorCode & _
ClientNodeAddress
Call SendData(strSendData)
End Sub
Private Sub Winsock1_Error(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)
'錯誤發生時
Call SocketStatus
Winsock1.Close
End Sub
Private Sub Command2_Click() '..............離開連線
Command3.Enabled = True
Command5.Enabled = True
Timer1.Enabled = False
C6 = 0
Command6.Enabled = True
'--- Socket Close
Winsock1.Close
Call SocketStatus
'--- 被斷訊為止待機
Do While Not (Winsock1.State = sckClosed)
DoEvents
Call SocketStatus
Loop
End Sub
Private Sub Command3_Click() '..............寫入單筆資料
Dim vv1 As String
Dim Ch_text1 As String
Dim vv2 As String
Dim Ch_text2 As String
vv1 = Text12.Text
vv2 = Text13.Text
If vv1 < 32761 Then
'..........轉換.........
Ch_text1 = Hex(Val(Text12.Text)) ' 10進制轉16進製
L = Len(Ch_text1)
Select Case L
Case 0
Ch_text1 = "0000"
Case 1
Ch_text1 = "000" & Ch_text1
Case 2
Ch_text1 = "00" & Ch_text1
Case 3
Ch_text1 = "0" & Ch_text1
Case Else
Ch_text1 = Ch_text1
End Select
'..........轉換.........
If vv2 < 65536 Then
Ch_text2 = Hex(Val(Text13.Text)) ' 10進制轉16進製
L = Len(Ch_text2)
Select Case L
Case 0
Ch_text2 = "0000"
Case 1
Ch_text2 = "000" & Ch_text2
Case 2
Ch_text2 = "00" & Ch_text2
Case 3
Ch_text2 = "0" & Ch_text2
Case Else
Ch_text2 = Ch_text2
End Select
'--- TCP(Winsock)資料送信內容
strReceiveDataMonitor = ""
FinsTcpHeader = "46494E53"
FinsTcpLength = "0000001C"
FinsTcpCommand = "00000002"
FinsTcpErrorCode = "00000000"
ICF$ = "80"
RSV$ = "00"
GCT$ = "02"
DNA = "00" '......網路層
DA1 = "00" '......PLC NODE NUMBER
DA2 = "00"
SNA = "00" '......網路層
SA1 = "00" '......PC NODE NUMBER
SA2 = "00"
SID = "00"
FCOMM = "010282" & Ch_text1 & "000001" & Ch_text2 '......FINSCOMMAND
'FinsFrame = ICF$ RSV$ GCT$ DNA DA1 DA2 SNA SA1 SA2 SID FCOMM
FinsFrame = ICF$ RSV$ GCT$ DNA DA1 DA2 SNA & hexClientNodeAddress SA2 SID FCOMM
strSendData = FinsTcpHeader & _
FinsTcpLength & _
FinsTcpCommand & _
FinsTcpErrorCode & _
FinsFrame
Call SendData(strSendData)
Else
MsgBox "輸入值太大"
End If
Else
MsgBox "輸入值太大"
End If
End Sub
Private Sub Command4_Click() '..............離開連線並關閉程式
' 處理完成
Call Command2_Click
End
End Sub
Private Sub Command5_Click() '..............讀取單筆資料
Dim Rec_m As String
Dim Ch_text As String
Dim vv As String
C5 = 1
Text23.Text = ""
Rec_m = ""
'--- TCP(Winsock)資料送信內容
strReceiveDataMonitor = ""
FinsTcpHeader = "46494E53"
FinsTcpLength = "0000001A"
FinsTcpCommand = "00000002"
FinsTcpErrorCode = "00000000"
ICF$ = "80"
RSV$ = "00"
GCT$ = "02"
DNA = "00" '......網路層
DA1 = "00" '......PLC NODE NUMBER
DA2 = "00"
SNA = "00" '......網路層
SA1 = "00" '......PC NODE NUMBER
SA2 = "00"
SID = "00"
vv = Text14.Text
If vv < 65536 Then
Ch_text = Hex(Val(Text14.Text)) ' 10進制轉16進製
L = Len(Ch_text)
Select Case L
Case 0
Ch_text = "0000"
Case 1
Ch_text = "000" & Ch_text
Case 2
Ch_text = "00" & Ch_text
Case 3
Ch_text = "0" & Ch_text
Case Else
Ch_text = Ch_text
End Select
FCOMM = "010182" & Ch_text & "000001" '......FINSCOMMAND
FinsFrame = ICF$ RSV$ GCT$ DNA DA1 DA2 SNA & hexClientNodeAddress SA2 SID FCOMM
strSendData = FinsTcpHeader & _
FinsTcpLength & _
FinsTcpCommand & _
FinsTcpErrorCode & _
FinsFrame
Call SendData(strSendData)
Else
MsgBox "輸入值太大"
End If
End Sub
Private Sub SendData(strSendData) '..............傳送資料碼
Text10.Text = ""
'--- Connection Check
If Winsock1.State <> 7 Then
Exit Sub
End If
'--- 算出Send Data之位元間隔字串。
strSendDataLine = (Len(strSendData)) / 2 - 1
'--- 算出之位元間隔數、SendData轉換為位元累積在SendData() ----
ReDim SendData(strSendDataLine) As Byte
j = 1
For i = 0 To strSendDataLine
SendData(i) = "&h" Mid$(strSendData, j, 2)
j = j 2
Next i
'--- 傳送資料顯示 ---
strSendDataMonitor = ""
For i = 0 To UBound(SendData)
strSendDataMonitor = strSendDataMonitor & "[" & Right("0" & Hex(CLng(SendData(i))), 2) & "]" & " "
Next
strSendDataMonitor = strSendDataMonitor & vbCrLf
Text10.Text = strSendDataMonitor
'--- 已轉換位元之SendData()之累積,利用Winsock通訊送信 ---
Winsock1.SendData SendData()
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
'---- ----
' Winsock受信資料取得
ReDim arrayByte(bytesTotal) As Byte
Call Winsock1.GetData(arrayByte, vbByte)
'---- ----
' Winsock受信資料顯示
'strSendDataMonitor = ""
'
Dim i As Integer
For i = 0 To UBound(arrayByte)
If arrayByte(11) = 1 Then
hexClientNodeAddress = Right("0" & Hex(CLng(arrayByte(19))), 2)
ClientNodeAddress = CLng(arrayByte(19))
ServerNodeAddress = CLng(arrayByte(23))
Text3.Text = ClientNodeAddress
Text9.Text = ServerNodeAddress
End If
Text23.Text = Text23.Text & Right("0" & Hex(CLng(arrayByte(i))), 2)
Rec_m = Rec_m & Right("0" & Hex(CLng(arrayByte(i))), 2)
strReceiveDataMonitor = strReceiveDataMonitor & "[" & Right("0" & Hex(CLng(arrayByte(i))), 2) & "]" & " "
Next
Call SocketStatus
strReceiveDataMonitor = strReceiveDataMonitor & vbCrLf
Text11.Text = strReceiveDataMonitor '.............顯示接收碼
'..............顯示讀取值 16hex to 10........
If C5 = 1 Then
Text15.Text = Val("&H" & Right(Rec_m, 4)) ' 16進製轉10進制 Val(&h...)
C5 = 0
End If
'..............連續顯示讀取值 16hex to 10........
If C6 = 1 Then
Text17.Text = Val("&H" & Mid(Rec_m, 61, 4)) ' 16進製轉10進制 Val(&h...)
Text18.Text = Val("&H" & Mid(Rec_m, 65, 4)) ' 16進製轉10進制 Val(&h...)
Text19.Text = Val("&H" & Mid(Rec_m, 69, 4)) ' 16進製轉10進制 Val(&h...)
Text20.Text = Val("&H" & Mid(Rec_m, 73, 4)) ' 16進製轉10進制 Val(&h...)
Text21.Text = Val("&H" & Mid(Rec_m, 77, 4)) ' 16進製轉10進制 Val(&h...)
End If
End Sub
Private Sub SocketStatus() '---- ----狀態確認
intSocketStatus = Winsock1.State
Select Case intSocketStatus
Case 0
strSocketStatus = "未連線"""
Case 6
strSocketStatus = "IP錯誤"
Case 7
strSocketStatus = "已連線"
Case 8
Winsock1.Close
strSocketStatus = "關閉連線中"
Case Else
strSocketStatus = Winsock1.State
End Select
'---- ----
' 狀態顯示
Label8.Caption = strSocketStatus
[/code]
系統時間:2017-10-23 14:05:18
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!