Private Const daveProtoMPI = 0
Private Const daveProtoMPI2 = 1
Private Const daveProtoMPI3 = 2
Private Const daveProtoPPI = 10
Private Const daveProtoAS511 = 20
Private Const daveProtoS7online = 50
Private Const daveProtoISOTCP = 122
Private Const daveProtoISOTCP243 = 123
Private Const daveProtoMPI_IBH = 223
Private Const daveProtoPPI_IBH = 224
Private Const daveProtoUserTransport = 255
Private Const daveSpeed9k = 0
Private Const daveSpeed19k = 1
Private Const daveSpeed187k = 2
Private Const daveSpeed500k = 3
Private Const daveSpeed1500k = 4
Private Const daveSpeed45k = 5
Private Const daveSpeed93k = 6
Private Const daveBlockType_OB = "8"
Private Const daveBlockType_DB = "A"
Private Const daveBlockType_SDB = "B"
Private Const daveBlockType_FC = "C"
Private Const daveBlockType_SFC = "D"
Private Const daveBlockType_FB = "E"
Private Const daveBlockType_SFB = "F"
Private Const daveSysInfo = &H3
Private Const daveSysFlags = &H5
Private Const daveAnaIn = &H6
Private Const daveAnaOut = &H7
Private Const daveP = &H80
Private Const daveInputs = &H81
Private Const daveOutputs = &H82
Private Const daveFlags = &H83
Private Const daveDB = &H84
Private Const daveDI = &H85
Private Const daveV = &H87
Private Const daveCounter = 28
Private Const daveTimer = 29
Private Const daveCounter200 = 30
Private Const daveTimer200 = 31
Private Const daveOrderCodeSize = 21
Private Const daveResOK = 0
Private Const daveResNoPeripheralAtAddress = 1
Private Const daveResMultipleBitsNotSupported = 6
Private Const daveResItemNotAvailable200 = 3
Private Const daveResItemNotAvailable = 10
Private Const daveAddressOutOfRange = 5
Private Const daveWriteDataSizeMismatch = 7
Private Const daveResCannotEvaluatePDU = -123
Private Const daveResCPUNoData = -124
Private Const daveUnknownError = -125
Private Const daveEmptyResultError = -126
Private Const daveEmptyResultSetError = -127
Private Const daveResUnexpectedFunc = -128
Private Const daveResUnknownDataUnitSize = -129
Private Const daveResShortPacket = -1024
Private Const daveResTimeout = -1025
Private Const daveMaxRawLen = 2048
Private Const daveDebugRawRead = &H1
Private Const daveDebugSpecialChars = &H2
Private Const daveDebugRawWrite = &H4
Private Const daveDebugListReachables = &H8
Private Const daveDebugInitAdapter = &H10
Private Const daveDebugConnect = &H20
Private Const daveDebugPacket = &H40
Private Const daveDebugByte = &H80
Private Const daveDebugCompare = &H100
Private Const daveDebugExchange = &H200
Private Const daveDebugPDU = &H400
Private Const daveDebugUpload = &H800
Private Const daveDebugMPI = &H1000
Private Const daveDebugPrintErrors = &H2000
Private Const daveDebugPassive = &H4000
Private Const daveDebugErrorReporting = &H8000
Private Const daveDebugOpen = &H8000
Private Const daveDebugAll = &H1FFFF
Private Declare Sub daveSetDebug Lib "atlantis.dll" (ByVal level As Long)
Private Declare Function daveGetDebug Lib "atlantis.dll" () As Long
Private Declare Function daveInternalStrerror Lib "atlantis.dll" Alias "daveStrerror" (ByVal en As Long) As Long
Private Declare Sub daveStringCopy Lib "atlantis.dll" (ByVal internalPointer As Long, ByVal s As String)
Private Declare Function daveNewInterface Lib "atlantis.dll" (ByVal fd1 As Long, ByVal fd2 As Long, ByVal name As String,

ByVal localMPI As Long, ByVal protocol As Long, ByVal speed As Long) As Long
Private Declare Function daveNewConnection Lib "atlantis.dll" (ByVal di As Long, ByVal mpi As Long, ByVal Rack As Long, ByVal

Slot As Long) As Long
Private Declare Function daveGetResponse Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveSendMessage Lib "atlantis.dll" (ByVal dc As Long, ByVal pdu As Long) As Long
Private Declare Sub daveDumpPDU Lib "atlantis.dll" (ByVal pdu As Long)
Private Declare Sub daveDump Lib "atlantis.dll" (ByVal name As String, ByVal pdu As Long, ByVal length As Long)
Private Declare Function daveInternalAreaName Lib "atlantis.dll" Alias "daveAreaName" (ByVal en As Long) As Long
Private Declare Function daveInternalBlockName Lib "atlantis.dll" Alias "daveBlockName" (ByVal en As Long) As Long
Private Declare Function daveSwapIed_16 Lib "atlantis.dll" (ByVal x As Long) As Long
Private Declare Function daveSwapIed_32 Lib "atlantis.dll" (ByVal x As Long) As Long
Private Declare Function toPLCfloat Lib "atlantis.dll" (ByVal f As Single) As Single
Private Declare Function daveToPLCfloat Lib "atlantis.dll" (ByVal f As Single) As Long
Private Declare Function daveGetS8from Lib "atlantis.dll" (ByRef buffer As Byte) As Long
Private Declare Function daveGetU8from Lib "atlantis.dll" (ByRef buffer As Byte) As Long
Private Declare Function daveGetS16from Lib "atlantis.dll" (ByRef buffer As Byte) As Long
Private Declare Function daveGetU16from Lib "atlantis.dll" (ByRef buffer As Byte) As Long
Private Declare Function daveGetS32from Lib "atlantis.dll" (ByRef buffer As Byte) As Long
Private Declare Function daveGetFloatfrom Lib "atlantis.dll" (ByRef buffer As Byte) As Single
Private Declare Function daveGetS8 Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetU8 Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetS16 Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetU16 Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetS32 Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetFloat Lib "atlantis.dll" (ByVal dc As Long) As Single
Private Declare Function daveGetS8At Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Long
Private Declare Function daveGetU8At Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Long
Private Declare Function daveGetS16At Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Long
Private Declare Function daveGetU16At Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Long
Private Declare Function daveGetS32At Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Long
Private Declare Function daveGetFloatAt Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Single
Private Declare Function davePut8 Lib "atlantis.dll" (ByRef buffer As Byte, ByVal value As Long) As Long
Private Declare Function davePut16 Lib "atlantis.dll" (ByRef buffer As Byte, ByVal value As Long) As Long
Private Declare Function davePut32 Lib "atlantis.dll" (ByRef buffer As Byte, ByVal value As Long) As Long
Private Declare Function davePutFloat Lib "atlantis.dll" (ByRef buffer As Byte, ByVal value As Single) As Long
Private Declare Function davePut8At Lib "atlantis.dll" (ByRef buffer As Byte, ByVal pos As Long, ByVal value As Long) As Long
Private Declare Function davePut16At Lib "atlantis.dll" (ByRef buffer As Byte, ByVal pos As Long, ByVal value As Long) As

Long
Private Declare Function davePut32At Lib "atlantis.dll" (ByRef buffer As Byte, ByVal pos As Long, ByVal value As Long) As

Long
Private Declare Function davePutFloatAt Lib "atlantis.dll" (ByRef buffer As Byte, ByVal pos As Long, ByVal value As Single)

As Long
Private Declare Function daveGetSeconds Lib "atlantis.dll" (ByVal dc As Long) As Single
Private Declare Function daveGetSecondsAt Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Single
Private Declare Function daveGetCounterValue Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetCounterValueAt Lib "atlantis.dll" (ByVal dc As Long, ByVal pos As Long) As Long
Private Declare Function daveGetOrderCode Lib "atlantis.dll" (ByVal en As Long, ByRef buffer As Byte) As Long
Private Declare Function daveConnectPLC Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveReadBytes Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As Long,

ByVal start As Long, ByVal numBytes As Long, ByVal buffer As Long) As Long
Private Declare Function daveManyReadBytes Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As

Long, ByVal start As Long, ByVal numBytes As Long, ByVal buffer As Long) As Long
Private Declare Function daveWriteBytes Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As Long,

ByVal start As Long, ByVal numBytes As Long, ByRef buffer As Byte) As Long
Private Declare Function daveWriteManyBytes Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As

Long, ByVal start As Long, ByVal numBytes As Long, ByRef buffer As Byte) As Long
Private Declare Function daveReadBits Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As Long,

ByVal start As Long, ByVal numBytes As Long, ByVal buffer As Long) As Long
Private Declare Function daveWriteBits Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As Long,

ByVal start As Long, ByVal numBytes As Long, ByRef buffer As Byte) As Long
Private Declare Function daveSetBit Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As Long, ByVal

start As Long, ByVal byteAddress As Long, ByVal bitAddress As Long) As Long
Private Declare Function daveClrBit Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal areaNumber As Long, ByVal

start As Long, ByVal byteAddress As Long, ByVal bitAddress As Long) As Long
Private Declare Function daveReadSZL Lib "atlantis.dll" (ByVal dc As Long, ByVal ID As Long, ByVal index As Long, ByRef

buffer As Byte, ByVal buflen As Long) As Long
Private Declare Function daveListBlocksOfType Lib "atlantis.dll" (ByVal dc As Long, ByVal typ As Long, ByRef buffer As Byte)

As Long
Private Declare Function daveListBlocks Lib "atlantis.dll" (ByVal dc As Long, ByRef buffer As Byte) As Long
Private Declare Function internalDaveGetBlockInfo Lib "atlantis.dll" Alias "daveGetBlockInfo" (ByVal dc As Long, ByRef buffer

As Byte, ByVal btype As Long, ByVal number As Long) As Long
Private Declare Function daveGetProgramBlock Lib "atlantis.dll" (ByVal dc As Long, ByVal blockType As Long, ByVal number As

Long, ByRef buffer As Byte, ByRef length As Long) As Long
Private Declare Function daveStart Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveStop Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveForce200 Lib "atlantis.dll" (ByVal dc As Long, ByVal area As Long, ByVal start As Long, ByVal

value As Long) As Long
Private Declare Sub davePrepareReadRequest Lib "atlantis.dll" (ByVal dc As Long, ByVal pdu As Long)
Private Declare Sub daveAddVarToReadRequest Lib "atlantis.dll" (ByVal pdu As Long, ByVal area As Long, ByVal areaNumber As

Long, ByVal start As Long, ByVal numBytes As Long)
Private Declare Function daveExecReadRequest Lib "atlantis.dll" (ByVal dc As Long, ByVal pdu As Long, ByVal rs As Long) As

Long
Private Declare Function daveUseResult Lib "atlantis.dll" (ByVal dc As Long, ByVal rs As Long, ByVal resultNumber As Long) As

Long
Private Declare Sub daveFreeResults Lib "atlantis.dll" (ByVal rs As Long)
Private Declare Sub daveAddBitVarToReadRequest Lib "atlantis.dll" (ByVal pdu As Long, ByVal area As Long, ByVal areaNumber As

Long, ByVal start As Long, ByVal numBytes As Long)
Private Declare Sub davePrepareWriteRequest Lib "atlantis.dll" (ByVal dc As Long, ByVal pdu As Long)
Private Declare Sub daveAddVarToWriteRequest Lib "atlantis.dll" (ByVal pdu As Long, ByVal area As Long, ByVal areaNumber As

Long, ByVal start As Long, ByVal numBytes As Long, ByRef buffer As Byte)
Private Declare Sub daveAddBitVarToWriteRequest Lib "atlantis.dll" (ByVal pdu As Long, ByVal area As Long, ByVal areaNumber

As Long, ByVal start As Long, ByVal numBytes As Long, ByRef buffer As Byte)
Private Declare Function daveExecWriteRequest Lib "atlantis.dll" (ByVal dc As Long, ByVal pdu As Long, ByVal rs As Long) As

Long
Private Declare Function daveInitAdapter Lib "atlantis.dll" (ByVal di As Long) As Long
Private Declare Function daveDisconnectPLC Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveDisconnectAdapter Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveListReachablePartners Lib "atlantis.dll" (ByVal dc As Long, ByRef buffer As Byte) As Long
Private Declare Sub daveSetTimeout Lib "atlantis.dll" (ByVal di As Long, ByVal maxTime As Long)
Private Declare Function daveGetTimeout Lib "atlantis.dll" (ByVal di As Long)
Private Declare Function daveInternalGetName Lib "atlantis.dll" Alias "daveGetName" (ByVal en As Long) As Long
Private Declare Function daveGetMPIAdr Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetAnswLen Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveGetMaxPDULen Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveNewResultSet Lib "atlantis.dll" () As Long
Private Declare Sub daveFree Lib "atlantis.dll" (ByVal item As Long)
Private Declare Function daveNewPDU Lib "atlantis.dll" () As Long
Private Declare Function daveGetErrorOfResult Lib "atlantis.dll" (ByVal resultSet As Long, ByVal resultNumber As Long) As

Long
Private Declare Function daveForceDisconnectIBH Lib "atlantis.dll" (ByVal di As Long, ByVal src As Long, ByVal dest As Long,

ByVal mpi As Long) As Long
Private Declare Function setPort Lib "atlantis.dll" (ByVal portName As String, ByVal baudrate As String, ByVal parity As

Byte) As Long
Private Declare Function openSocket Lib "atlantis.dll" (ByVal port As Long, ByVal peer As String) As Long
Private Declare Function openS7online Lib "atlantis.dll" (ByVal peer As String) As Long
Private Declare Function closePort Lib "atlantis.dll" (ByVal fh As Long) As Long
Private Declare Function closeS7online Lib "atlantis.dll" (ByVal fh As Long) As Long
Private Declare Function daveReadPLCTime Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveSetPLCTime Lib "atlantis.dll" (ByVal dc As Long, ByRef timestamp As Byte) As Long
Private Declare Function daveSetPLCTimeToSystime Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveToBCD Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Declare Function daveFromBCD Lib "atlantis.dll" (ByVal dc As Long) As Long
Private Function daveStrError(ByVal code As Long) As String
x$ = String$(256, 0)
ip = daveInternalStrerror(code)
Call daveStringCopy(ip, x$)
x$ = Left$(x$, InStr(x$, Chr$(0)) - 1)
daveStrError = x$
End Function

Private Function daveAreaName(ByVal code As Long) As String
x$ = String$(256, 0)
ip = daveInternalAreaName(code)
Call daveStringCopy(ip, x$)
x$ = Left$(x$, InStr(x$, Chr$(0)) - 1)
daveAreaName = x$
End Function
Private Function daveBlockName(ByVal code As Long) As String
x$ = String$(256, 0)
ip = daveInternalBlockName(code)
Call daveStringCopy(ip, x$)
x$ = Left$(x$, InStr(x$, Chr$(0)) - 1)
daveBlockName = x$
End Function
Private Function daveGetName(ByVal di As Long) As String
x$ = String$(256, 0)
ip = daveInternalGetName(di)
Call daveStringCopy(ip, x$)
x$ = Left$(x$, InStr(x$, Chr$(0)) - 1)
daveGetName = x$
End Function
Private Function daveGetBlockInfo(ByVal di As Long) As Byte
x$ = String$(256, 0)
ip = daveInternalGetName(di)
Call daveStringCopy(ip, x$)
x$ = Left$(x$, InStr(x$, Chr$(0)) - 1)
daveGetName = x$
End Function
Sub initTable()
Cells(2, 4) = "串口:"
Cells(2, 5) = "COM1"
Cells(3, 4) = "波特率:"
Cells(3, 5) = "38400"
Cells(4, 4) = "奇偶效验:"
Cells(4, 5) = "O"
Cells(6, 4) = "MPI/PPI 地址:"
Cells(6, 5) = 2
Cells(7, 4) = "IP 地址:"
Cells(7, 5) = "192.168.1.1"
Cells(8, 4) = "组太站点:"
Cells(8, 5) = "/S7ONLINE"
End Sub
Private Function initialize(ByRef ph As Long, ByRef di As Long, ByRef dc As Long)
ph = 0
di = 0
dc = 0
Rem uncomment the daveSetDebug... line, save your sheet
Rem run excel from dos box with: excel yoursheet >debugout.txt
Rem send me the file debugout.txt if you have trouble.
Rem call daveSetDebug(daveDebugAll)
initialize = -1
baud$ = Cells(3, 5)
If (baud$ = "") Then Call initTable
Cells(12, 2) = "运行中"
res = -1
port = Cells(2, 5)
baud$ = Cells(3, 5)
parity$ = Cells(4, 5)
peer$ = Cells(7, 5)
acspnt$ = Cells(8, 5)
ph = setPort(port, baud$, Asc(Left$(parity$, 1)))
' 可选一:
Rem ph = openSocket(102, peer$)
Rem ph = openSocket(1099, peer$)
Rem ph = openS7online(acspnt$) '
Cells(2, 1) = "port handle:"
Cells(2, 2) = ph
If (ph > 0) Then
di = daveNewInterface(ph, ph, "IF1", 0, daveProtoMPI, daveSpeed187k)
' 可选二:
'di = daveNewInterface(ph, ph, "IF1", 0, daveProtoPPI, daveSpeed187k)
'di = daveNewInterface(ph, ph, "IF1", 0, daveProtoMPI_IBH, daveSpeed187k)
'di = daveNewInterface(ph, ph, "IF1", 0, daveProtoISOTCP, daveSpeed187k)
'di = daveNewInterface(ph, ph, "IF1", 0, daveProtoS7online, daveSpeed187k)
'
' Call daveSetTimeout(di, 500000)
res = daveInitAdapter(di)
Cells(3, 1) = "初始化适配器结果:"
Cells(3, 2) = res
If res = 0 Then
MpiPpi = Cells(6, 5)
'
'
dc = daveNewConnection(di, MpiPpi, Rack, Slot)
res = daveConnectPLC(dc)
Cells(4, 1) = "连接PLC:"
Cells(4, 2) = res
If res = 0 Then
initialize = 0
End If
End If
End If
End Function
Private Sub cleanUp(ByRef ph As Long, ByRef di As Long, ByRef dc As Long)
If dc <> 0 Then
res = daveDisconnectPLC(dc)
Call daveFree(dc)
dc = 0
End If
If di <> 0 Then
res = daveDisconnectAdapter(di)
Call daveFree(di)
di = 0
End If
If ph <> 0 Then
res = closePort(ph)
ph = 0
End If
Cells(12, 2) = "完成"
End Sub
Sub readFromPLC()
Cells(1, 2) = "PLC读取"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
res2 = daveReadBytes(dc, daveFlags, 0, 0, 16, 0)
Cells(5, 1) = "readBytes读出结果:"
Cells(5, 2) = res2
If res2 = 0 Then
v1 = daveGetS32(dc)
Cells(7, 1) = "MD0(DINT):"
Cells(7, 2) = v1
v2 = daveGetS32(dc)
Cells(8, 1) = "MD4(DINT):"
Cells(8, 2) = v2
v3 = daveGetS32(dc)
Cells(9, 1) = "MD8(DINT):"
Cells(9, 2) = v3
v4 = daveGetFloat(dc)
Cells(10, 1) = "MD12(REAL):"
Cells(10, 2) = v4
v5 = daveGetFloatAt(dc, 12)
Else
e$ = daveStrError(res)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
End If
Call cleanUp(ph, di, dc)
End Sub

Sub startPLC()
Cells(1, 2) = "启动PLC"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
res2 = daveStart(dc)
Cells(14, 2) = res2
Else
e$ = daveStrError(res)
Cells(9, 5) = e$
End If
Call cleanUp(ph, di, dc)
End Sub
Sub stopPLC()
Cells(1, 2) = "启动PLC"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
res2 = daveStop(dc)
Cells(14, 1) = "结果:"
Cells(14, 2) = res2
Else
e$ = daveStrError(res)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
Call cleanUp(ph, di, dc)
End Sub

Sub readOrderCode()
Cells(1, 2) = "测试读取订货号"
Dim ph As Long, di As Long, dc As Long
Dim buffer(50) As Byte
res = initialize(ph, di, dc)
If res = 0 Then
res2 = daveGetOrderCode(dc, buffer(0))
Cells(14, 2) = res2
If res2 = 0 Then
For i = 0 To daveOrderCodeSize - 2 'last character is chr$(0), don't copy it
oc$ = oc$ + Chr$(buffer(i))
Next i
Cells(14, 3) = oc$
Else
e$ = daveStrError(res)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
End If
Call cleanUp(ph, di, dc)
End Sub

Sub readDiagnostic()
Dim buffer(4096) As Byte
Cells(1, 2) = "CPU读取诊断 (A0,0)"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
ID = &HA0
res2 = daveReadSZL(dc, ID, 0, buffer(0), 4096)
If res2 = 0 Then
al = daveGetAnswLen(dc)
If (al >= 4) Then
ID = daveGetU16from(buffer(0))
index = daveGetU16from(buffer(2))
If (al >= 8) Then
Cells(1, 15) = "CPU诊断读取列表"
ItemLen = daveGetU16from(buffer(4))
ItemCount = daveGetU16from(buffer(6))
bpos = 8 ' remember buffer position
For i = 0 To ItemCount - 1
dia$ = ""
For j = 0 To ItemLen - 1
dia$ = dia$ + Hex$(buffer(bpos)) + ","
bpos = bpos + 1
Next j
Cells(i + 3, 15) = dia$
Next i
End If
End If
Else
e$ = daveStrError(res2)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
End If
Call cleanUp(ph, di, dc)
End Sub



Sub bufferTest()
Dim buffer(1024) As Byte
buffer(0) = 255
buffer(1) = 255
buffer(2) = 255
buffer(3) = 255
t1 = daveGetS8from(buffer(0))
t2 = daveGetU8from(buffer(1))
t3 = daveGetS16from(buffer(0))
t4 = daveGetU16from(buffer(1))
t5 = daveGetS32from(buffer(0))
't6 = daveGetU32from(buffer(0))

v1 = Cells(7, 2)
a = davePut32(buffer(0), Cells(7, 2))
a = davePut32(buffer(4), Cells(8, 2))
a = davePut32(buffer(8), Cells(9, 2))
a = davePutFloat(buffer(12), Cells(10, 2))
a0 = buffer(0)
a1 = buffer(1)
a2 = buffer(2)
a3 = buffer(3)
a4 = buffer(4)
a5 = buffer(5)
a6 = buffer(6)
a7 = buffer(7)
a8 = buffer(8)
a9 = buffer(9)
a10 = buffer(10)
a11 = buffer(11)
a12 = buffer(12)
a13 = buffer(13)
a14 = buffer(14)
a15 = buffer(15)
End Sub
Sub writeToPLC()
Dim buffer(1024) As Byte
Cells(1, 2) = "PLC写入测试"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
a = davePut32(buffer(0), Cells(7, 2))
a = davePut32(buffer(4), Cells(8, 2))
a = davePut32(buffer(8), Cells(9, 2))
a = davePutFloat(buffer(12), Cells(10, 2))
res2 = daveWriteBytes(dc, daveFlags, 0, 0, 16, buffer(0))
e$ = daveStrError(res2)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
Call cleanUp(ph, di, dc)
End Sub
Sub stringtest()
For i = 0 To 255
a$ = daveStrError(i)
b$ = daveAreaName(i)
C$ = daveBlockName(i)
Cells(6 + i, 7) = i
Cells(6 + i, 8) = a$
Cells(6 + i, 9) = b$
Cells(6 + i, 10) = C$
Next i
End Sub

Sub readMultipleItemsFromPLC()
Dim resultSet As Long
Dim pdu As Long
Cells(1, 2) = "多PLC读取测试:"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
pdu = daveNewPDU
Call davePrepareReadRequest(dc, pdu)
Call daveAddVarToReadRequest(pdu, daveFlags, 0, 0, 4)
Call daveAddVarToReadRequest(pdu, daveFlags, 0, 8, 8)
resultSet = daveNewResultSet
res2 = daveExecReadRequest(dc, pdu, resultSet)
Cells(5, 2) = res2
If res2 = 0 Then
res3 = daveUseResult(dc, resultSet, 0)
v1 = daveGetS32(dc)
Cells(7, 2) = v1
res3 = daveUseResult(dc, resultSet, 0)
v2 = daveGetS32(dc)
Cells(8, 2) = v2
v4 = daveGetFloat(dc)
Cells(10, 2) = v4
daveFreeResults (resultSet)
Else
e$ = daveStrError(res2)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
daveFree (resultSet)
daveFree (pdu)
End If
Call cleanUp(ph, di, dc)
End Sub

Sub writeMultipleItemsToPLC()
Dim resultSet As Long
Dim pdu As Long
Cells(1, 2) = "Testing multiple item PLC write"
Dim ph As Long, di As Long, dc As Long
res = initialize(ph, di, dc)
If res = 0 Then
pdu = daveNewPDU
res = daveGetMaxPDULen(dc)
Call davePrepareWriteRequest(dc, pdu)
Call daveAddVarToWriteRequest(pdu, daveFlags, 0, 0, 4, buffer)
Call daveAddVarToWriteRequest(pdu, daveDB, 6, 8, 8, buffer)
resultSet = daveNewResultSet
res2 = daveExecWriteRequest(dc, pdu, resultSet)
Cells(5, 1) = "执行结果:"
Cells(5, 2) = res2
If res2 = 0 Then
res3 = daveGetErrorOfResult(resultSet, 0)
res3 = daveGetErrorOfResult(resultSet, 1)
daveFreeResults (resultSet)
Else
e$ = daveStrError(res2)
Cells(9, 4) = "错误:"
Cells(9, 5) = e$
End If
daveFree (resultSet)
daveFree (pdu)
End If
Call cleanUp(ph, di, dc)
End Sub

Sub readProgramBlock()
Cells(1, 2) = "读取OB1并测试"
Dim ph As Long, di As Long, dc As Long, buffer(3000) As Byte, length As Long
res = initialize(ph, di, dc)
If res = 0 Then
res = daveGetProgramBlock(dc, Asc("8"), 1, buffer(0), length)
bpos = 0
Cells(16, 2) = "OB1内容:"
For i = 0 To 1 + Int(length / 16)
dia$ = ""
For j = 0 To 15
dia$ = dia$ + Hex$(buffer(bpos)) + ","
bpos = bpos + 1
Next j
Cells(i + 17, 2) = dia$
Next i
End If
Call cleanUp(ph, di, dc)
End Sub

由于前段时间忙着写毕业论文,找工作,没时间上来!让大家旧等了!
由于无法上传文件,atlantis.dll还是传不上来!只有先把在VB中的使用方法原代码发上来了,大家看看!PERL,JAVA,C/C++都有加入!需要的说一声哈!
各位哥们有没有可以上传的地方呀!麻烦用一下!