VB 轉換成 BCB 問題 - Delphi K.Top 討論區

#1 引用回覆回覆

發表時間：2012-03-18 16:04:14

IP:114.44.xxx.xxx 訂閱

由於小弟對VB涉及不深，不知有沒有高手可以協助將此vb碼轉換成BCB的語言呢？感謝！
[code vb]

'# Microsoft Visual Basic Winsock(TCP/IP)

'Option Explicit

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) & "]" & " "

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) & "]" & " "

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

End Sub

[/code]

附加檔案：4f6596fe67a07_TCPIP.rar