diff --git a/CIniFile.cls b/CIniFile.cls new file mode 100644 index 0000000..2b249a4 --- /dev/null +++ b/CIniFile.cls @@ -0,0 +1,152 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "CIniFile" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +'[Section1] +'Key1 = Value1 +'Key2 = Value2 +'Key3 = Vlaue3 +' +'[Section2] +'Key1 = Value1 +'Key2 = Value5 +'Key4 = Value4 +'Key5=... +' +'... + +'Private Declare Function GetPrivateProfileInt Lib "kernel32" _ +'Alias "GetPrivateProfileIntA" ( _ ' 返回所读取的长整型值 +' ByVal lpApplicationName As String, _ ' 要读取的段 (Section) 名称 +' ByVal lpKeyName As String, _ ' 要读取的的键 (Key) 名称 +' ByVal nDefault As Long, _ ' 指定默认值，如果读取时出错，则返回该值 +' ByVal lpFileName As String) As Long ' 指定要读的 INI 文件名 +' +'Private Declare Function GetPrivateProfileString Lib "kernel32" _ +'Alias "GetPrivateProfileStringA" ( _ ' 返回所读取的字符串值的真实长度 +' ByVal lpApplicationName As String, _ ' 要读取的段 (Section) 名称 +' ByVal lpKeyName As Any, _ ' 要读取的的键 (Key) 名称 +' ByVal lpDefault As String, _ ' 指定默认值，如果读取时出错，则返回该值 +' ByVal lpReturnedString As String, _ ' 指定接收返回值的字符串变量 +' ByVal nSize As Long, _ ' 指定允许字符串值的最大长度 +' ByVal lpFileName As String) As Long ' 指定要读的 INI 文件名 +' +'Private Declare Function WritePrivateProfileString Lib "kernel32" _ +'Alias "WritePrivateProfileStringA" ( _ ' 如果成功返回非 0 值，失败返回 0 +' ByVal lpApplicationName As String, _ ' 要写入的段 (Section) 名称 +' ByVal lpKeyName As Any, _ ' 要写入的的键 (Key) 名称 +' ByVal lpString As Any, _ ' 要写入的值 (Value)，以字符串表示 +' ByVal lpFileName As String) As Long ' 指定要写的 INI 文件名 +Private Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault As Long, ByVal lpFileName As String) As Long +Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long +Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long + + +Private IniFileName As String '文件名 +Public ErrorMsg As String '错误信息 + + + + +Private Sub Class_Initialize() + IniFileName = vbNullString + ErrorMsg = vbNullString + +End Sub + +Public Sub SpecifyIni(FilePathName As String) '指定 INI 文件名给 CIniFile + IniFileName = Trim(FilePathName) +End Sub + + Private Function NoIniFile() As Boolean '判断是否已经指定了 INI 文件名 + NoIniFile = True + If IniFileName = vbNullString Then + ErrorMsg = "没有指定 INI 文件" + Exit Function + End If + ErrorMsg = vbNullString + NoIniFile = False +End Function + +'该方法在 INI 文件中写入一个键值，成功返回 True，失败返回 False。 +'根据 WritePrivateProfileString 的需要，除了文件名这一参数不用提供之外， +'需要提供段名、键名和值三个参数，而且这三个参数当然来自用户。 +'而 WritePrivateProfileString 是通过返回值是否为 0 来判断是否成功的， +'所以可以通过判断 WritePrivateProfileString 的返回值是否非 0 来返回 True 或 False。 + +Public Function WriteString(Section As String, key As String, Value As String) As Boolean '写文件 + WriteString = False + If NoIniFile() Then + Exit Function + End If + If WritePrivateProfileString(Section, key, Value, IniFileName) = 0 Then + ErrorMsg = "写入失败" + Exit Function + End If + WriteString = True +End Function + +'这个方法在 INI 文件中读取一个键值，作为字符串返回。 +'如果参数 Size 给定的大小不够，将不能返回完整的值串，但不会有任何提示。 +'写这个函数的关键在 ReturnStr 的初始化和取值上。 +'VB 中是不需要对字符串进行初始化的，也不需要分配空间。 +'但是这里如果不将它初始化为一个足够长的字符串，就不能正确返回结果。 +'这和 C 语言的字符串有关，就不多说了。 +'ReturnStr 的取值也需要有趣，要使用 Left() 函数将其截断。 +'如果不截断，取得的结果字符串就会有 Size 那么长， +'除了取得的值以外，其余部分都是用空格填充的。 +'其原因与前面一点相同，与 C 语言的字符串有关。 +'当然 Left() 函数也可以使用 Trim() 代替，效果是一样的。 +Public Function ReadString(Section As String, key As String, Size As Integer) As String + On Error GoTo Errmsg + Dim ReturnStr As String + Dim ReturnLng As Long + ReadString = vbNullString + If NoIniFile() Then + Exit Function + End If + ReturnStr = Space(Size) + ReturnLng = GetPrivateProfileString(Section, key, vbNullString, ReturnStr, Size, IniFileName) + ReadString = Left(ReturnStr, ReturnLng) + Exit Function +Errmsg: + MsgBox Err.Description + +End Function + + +'这个方法在 INI 文件中读取一个整数值，失败时返回 0。 +'考虑到某些键的值也可能为 0，故应结合 ErrorMsg 判断是否成功。 +'这个方法中调用了两次 GetPrivateProfileInt，为什么要这样呢？ +'因为 GetPrivateProfileInt 如果成功则返回取得的值，如果不成功则返回给定的默认值。 +'这样就会出现一种情况：如果我给的默认值是 0，GetPrivateProfileInt 函数取得的值也是 0， +'那么它是成功还是失败呢？ +'同样，如果我给的默认值是 1，GetPrivateProfileInt 函数取得的值也是 1， +'那就是成功还是失败呢？既然一次取值无法判断，那就多取一次，第一次设定默认值为 0， +'第二次设定默认值为 1，INI 文件的中值不会跟着我的默认值变吧？！ +'虽然这样麻烦一些，但毕竟把问题解决了。 + Public Function ReadInt(Section As String, key As String) As Long + Dim ReturnLng As Long + ReadInt = 0 + ReturnLng = GetPrivateProfileInt(Section, key, 0, IniFileName) + If ReturnLng = 0 Then + ReturnLng = GetPrivateProfileInt(Section, key, 1, IniFileName) + If ReturnLng = 1 Then + ErrorMsg = "不能读取" + Exit Function + End If + End If + ReadInt = ReturnLng +End Function + + + diff --git a/CSVParse.cls b/CSVParse.cls new file mode 100644 index 0000000..126c586 --- /dev/null +++ b/CSVParse.cls @@ -0,0 +1,146 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "CSVParse" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit + +Dim FSO ' A File Scripting object +Dim TS ' A Text Stream +Private mvarFileName As String ' Path to the target file +Private mvarFieldCount As Integer ' Count of fields in this record +Private mvarRecordCount As Integer ' Count of records in this file +Private mvarStatus As Boolean ' Are we able to provide data? +Private strRecord As String ' Current record +Private Fields() As String ' Current record field array +'Private NewFields() As String +Private strErrMsg As String ' Last error message +Private mvarFieldSeperator As String ' User defined field seperator + +'------------------------------------------------------------------------------ +' CSV Parser +' This class handles retrieving elements from a CSV (C_omma S_eperated V_alues) +' file. In the CSV file each line is a record and each field in the record is +' seperated from its neighbor by a delimiter character. The character is usually +' a comma (,) but can be any character. +' +' This class requires a reference to the MS Scripting Runtime. +' +' Create an instance of the class (Dim CSVP as New CSVParse) +' Set the FieldSeperator property if it is not comma. +' Set the FileName property using the full path to the target file. +' a. Read the Status property. If it is false, the file was not +' accessed so call the GetErrorMessage function to retrieve the +' descripition of the problem +' Process the file as follows: +' +' While CSVP.LoadNextLine = True +' MyString = CSVP.GetField(n) <- for each field you want to read +' where n is the field number where +' . 1 is the first field. +' . +' . +' Wend +'---------------------------------------------------------------------------- +' Return the message string +Public Function GetErrorMessage() As String + GetErrorMessage = strErrMsg +End Function + +' Set the field delimiter character. Default is the comma. +Public Property Let FieldSeperator(ByVal vData As String) + mvarFieldSeperator = Trim(vData) +End Property + +Public Property Get FieldSeperator() As String + FieldSeperator = mvarFieldSeperator +End Property + +' Internal status set +Private Property Let Status(ByVal vData As Boolean) + mvarStatus = vData +End Property + +' Tell caller the status +Public Property Get Status() As Boolean + Status = mvarStatus +End Property + +' Give out the number of fields in this record +Public Property Get FieldCount() As Integer + FieldCount = mvarFieldCount +End Property + +' Set the target file name +Public Property Let FileName(ByVal vData As String) + mvarFileName = vData 'Set the file path + mvarStatus = AccessTargetFile() 'Open it +End Property + +' Reads the next line of text and parses it into fields array +Public Function LoadNextLine() As Boolean + On Error GoTo LoadNextLine_Err + If TS.atendofstream Then + LoadNextLine = False + Exit Function + End If + strRecord = TS.readline + ReDim Fields(0) + Fields = Split(strRecord, FieldSeperator) 'Break out the string of fields + mvarFieldCount = UBound(Fields) + 1 '# of fields available + LoadNextLine = True + Exit Function +LoadNextLine_Err: + LoadNextLine = False 'Should happen at EOF... +End Function + +' Pass back the specified field +Public Function GetField(FieldNum As Integer) As String + If FieldNum < 1 Or FieldNum > FieldCount Then + GetField = "" + Else + GetField = Trim(Fields(FieldNum - 1)) + End If +End Function + +' 在文件尾添加一条新纪录 + +' Open the target file... +Private Function AccessTargetFile() As Boolean + On Error Resume Next + TS.Close 'Close if open. + On Error GoTo AccessTargetFile_Err + Status = True + strErrMsg = "" + Set TS = FSO.OpenTextFile(mvarFileName, 1) + AccessTargetFile = True + Status = True + Exit Function +AccessTargetFile_Err: + strErrMsg = CStr(Err.number) & " " & Err.Description & " in AccessTargetFile." + AccessTargetFile = False +End Function + +' Normal VB class initialization +Private Sub Class_Initialize() + Status = False 'Not open for business yet + FieldSeperator = "," 'Default to comma + mvarFileName = "" 'No file yet + Set FSO = CreateObject("Scripting.FileSystemObject") +End Sub + +' Normal VB class termination +Private Sub Class_Terminate() + Set FSO = Nothing 'Clean up - destroy objects + Set TS = Nothing +End Sub + + diff --git a/Copy of OPC_CONF.csv b/Copy of OPC_CONF.csv new file mode 100644 index 0000000..092c948 --- /dev/null +++ b/Copy of OPC_CONF.csv @@ -0,0 +1,722 @@ +No,Tag,TagName, +1,A1001 +2,A1002 +3,A1003 +4,A1007 +5,A1012 +6,A1201 +7,A1202 +8,A12211 +9,A12212 +10,A1222 +11,A1223 +12,A1226 +13,A1228 +14,D12281 +15,II1001C +16,II1002C +17,II1003C,PC_STARTA +18,SI1007C, +19,II1007C, +20,II1201C, +21,II1222C, +22,II1223C, +23,A1301, +24,A13021, +25,A13022, +26,A13031, +27,A13032, +28,A13041, +29,A13042, +30,A1306, +31,A1317, +32,ZR13181, +33,ZR1307 +34,A1308 +35,A1319 +36,ZF1321 +37,A1313 +38,A1309 +39,A1310 +40,A1311 +41,A1312 +42,A1315 +43,A1616 +44,A1615 +45,A1401 +46,ZR1402 +47,A1607 +48,A16064 +49,A16063 +50,A16062 +51,A16061 +52,A1327 +53,A16041 +54,A16042 +55,A1618 +56,LIA1301C +57,LIA1302C +58,LIA1303C +59,LIA1304C +60,II13021C +61,II13031C +62,II13041C +63,SumFIRaw +64,FI1301C +65,FI13022C +66,FI13032C +67,FI13042C +68,Total1301 +69,Total13022 +70,Total13032 +71,Total13042 +72,TotalRaw +73,TotalRaw +74,TotalRaw +75,TotalRaw +76,RUNDAYM1309 +77,RUNTIMEM1309 +78,II1317C +79,II1306C +80,LIA1318C +81,TIA13091C +82,PI1309IC +83,TIA1309IC +84,XIA13093C +85,XIA13094C +86,XIA13091C +87,XIA13092C +88,TIA1309Z1C +89,TIA1309C +90,PI13111C +91,PI13112C +92,II1309C +93,LIA13091C +94,LIA13092C +95,LIA13093C +96,PT1309C +97,SI1315C +98,II1315C +99,PI1309OC +100,TIA1309OC +101,ZI1326C +102,PI1330C +103,PI1327IC +104,ZI1327C +105,ZI1322C +106,ZI1321C +107,ZI1325C +108,ZI1604C +109,ZI1324C +110,PI1327OC +111,TIA1327OC +112,II1327C +113,PI1604AIC +114,TIA1604AIC +115,PI1604BIC +116,TIA1604BIC +117,PI1604Ad +118,PI1604Bd +119,CO_15041C +120,PI1604AOC +121,PI1604BOC +122,II1618C +123,ZI1618C +124,LIA1401C +125,A11011 +126,A11012 +127,A1102 +128,A1103 +129,D11031 +130,A1104 +131,A1105 +132,A1106 +133,A1107 +134,A1801 +135,A1812 +136,A1804 +137,A1810 +138,A1832 +139,A1832 +140,A1832 +141,A1832 +142,A1832 +143,A1832 +144,AR1813 +145,AF1813 +146,A1833 +147,FI11011C +148,FI11012C +149,Total11011 +150,Total11012 +151,II1102C +152,II1103C +153,II1105C +154,II1106C +155,II1107C +156,LIA1801C +157,FI1801C +158,Total1801 +159,ZI18041C +160,ZI18042C +161,TIA1804IC +162,PI1804IC +163,TIA1809BC +164,II1804C +165,TIA1809AC +166,TIA1804C +167,TIA1804ZC +168,NIA1804C +169,TIA1806C +170,TIA1804OC +171,PI1804OC +172,II1810C +173,SI1810C +174,TIA1810C +175,PI1810C +176,PI1832IC +177,ANA3_COC +178,PIA1832C +179,PI1832OC +180,TIA1832OC +181,ZI1833C +182,II1833C +183,XIA1833C +184,ANA4_COC +185,WIA1823C +186,WIA1824C +187,FI1823C +188,FI1824C +189,A1506 +190,A14281 +191,A14282 +192,A1521 +193,A1522 +194,A1512 +195,A15121 +196,A1515 +197,A15131 +198,A1519 +199,A1520 +200,A1523 +201,A15301 +202,A15302 +203,A15303 +204,A15304 +205,A15305 +206,A15306 +207,A15307 +208,A15308 +209,A15311 +210,A15312 +211,Ack15313 +212,Ack15321 +213,Ack15322 +214,Ack15323 +215,Ack15331 +216,Ack15332 +217,Ack15333 +218,A1703 +219,A15281 +220,A15282 +221,A15283 +222,A1529 +223,A14143 +224,A14142 +225,A14141 +226,A1825 +227,A1826 +228,A1827 +229,A1828 +230,A14231 +231,A14232 +232,A1823 +233,A1824 +234,O2_15041C +235,CO_15041C +236,SO2_15041C +237,NOX_15041C +238,II1506C +239,SI1506C +240,XIA15061C +241,XIA15062C +242,TIA1601IC +243,PI1601C +244,TIA1601OC +245,FI1609C +246,O2_15043C +247,CO_15043C +248,NOX_15043C +249,O2_15042C +250,CO_15042C +251,NOX_15042C +252,TIA1506IC +253,PI1506IC +254,TIA1502B2C +255,PI1502B2C +256,TIA1502B1C +257,PI1502B1C +258,TIA1502A2C +259,PI1502A2C +260,TIA1502A1C +261,PI1502A1C +262,TIA1503B2C +263,PI1503B2C +264,TIA1503B1C +265,PI1503B1C +266,TIA1504BC +267,PI1504BC +268,TIA1504AC +269,PI1504AC +270,TIA1503A2C +271,PI1503A2C +272,TIA1503A1C +273,PI1503A1C +274,TIA1506BC +275,PI1506BC +276,TIA1505BC +277,PI1505BC +278,TIA1505AC +279,PI1505AC +280,TIA1506AC +281,PI1506AC +282,TIA1507BC +283,PI1507BC +284,TIA1508BC +285,PI1508BC +286,TIA1508AC +287,PI1508AC +288,TIA1507AC +289,PI1507AC +290,TIA1510BC +291,PI1510BC +292,TIA1509BC +293,PI1509BC +294,TIA1509AC +295,PI1509AC +296,TIA1510AC +297,PI1510AC +298,TIA1511BC +299,PI1511BC +300,TIA1512BC +301,PI1512BC +302,TIA1512AC +303,PI1512AC +304,TIA1511AC +305,PI1511AC +306,TIA1514C +307,PI1514C +308,II1521C +309,TIA1515C +310,PI1515C +311,SI1512C +312,II1512C +313,TIA15121C +314,TIA15122C +315,TIA15123C +316,PI1520C +317,TIA1535C +318,II14143C +319,II14142C +320,II14141C +321,II1825C +322,II1826C +323,II1827C +324,II1828C +325,FI1823C +326,FI1824C +327,WIA1823C +328,WIA1824C +329,FI14231C +330,FI14232C +331,ZI14211C +332,ZI14221C +333,WIA1423C +334,Total1423 +335,LIA1401C +336,II14281C +337,II14282C +338,Ack1527 +339,A15271 +340,A15281 +341,A15282 +342,A15283 +343,A15301 +344,A15302 +345,A15303 +346,A15304 +347,A15305 +348,A15306 +349,A15311 +350,A15312 +351,Ack15313 +352,A15307 +353,A15308 +354,Ack15321 +355,Ack15322 +356,Ack15323 +357,Ack15331 +358,Ack15332 +359,Ack15333 +360,A1529 +361,A1534 +362,A15362 +363,A15361 +364,A15359 +365,A15357 +366,A15355 +367,A15353 +368,A15351 +369,A15352 +370,A15354 +371,A15356 +372,A15358 +373,A1537 +374,A15371 +375,A15374 +376,A15372 +377,A15375 +378,A15373 +379,A15376 +380,A15391 +381,A15392 +382,A1540 +383,A1703 +384,ZR17011 +385,ZR17012 +386,ZR17024 +387,A1701 +388,A1538 +389,SI1527C +390,PI1527C +391,II1527C +392,PI1520C +393,TIA1535C +394,TIA1528L1C +395,TIA1528L2C +396,TIA1528R1C +397,TIA1528R2C +398,II1528aC +399,SI15281C +400,II1528bC +401,SI15282C +402,II1528cC +403,SI15283C +404,II1528dC +405,II1529C +406,TIA15285C +407,PI1528aC +408,PI1528bC +409,PI1528cC +410,PI1528dC +411,PI1528eC +412,PI1528fC +413,PI1528gC +414,PI1528hC +415,PI1528iC +416,TIA1529ZC +417,II15301C +418,II15302C +419,II15303C +420,II15304C +421,II15305C +422,II15306C +423,II15311C +424,II15312C +425,II15313C +426,II15307C +427,II15308C +428,II15321C +429,II15322C +430,II15323C +431,II15331C +432,II15332C +433,II15333C +434,ZI1539C +435,PI1537C +436,TIA1537IC +437,PI1542OC +438,TIA1542OC +439,PI1538C +440,ZI1538C +441,II1538C +442,XIA15381C +443,XIA15382C +444,II1703C +445,II1701C +446,LIA1701C +447,LIA1702C +448,A1915 +449,A1916 +450,A1917 +451,A1918 +452,A1919 +453,A1920 +454,A1921 +455,ZF1922 +456,A1926 +457,A1929 +458,A1927 +459,A1928 +460,A1929B +461,A1929A +462,ZF19392 +463,A1939 +464,A1940 +465,A1933 +466,A1931 +467,A1934 +468,A1935 +469,A1943 +470,LIA17211C +471,LIA19151C +472,LIA19161C +473,LIA19171C +474,II1919C +475,SumFICementA +476,FI1915C +477,FI1916C +478,FI1917C +479,FI1918C +480,FI1914C +481,Total1915 +482,Total1916 +483,Total1917 +484,Total1918 +485,Total1914 +486,TotalCementA +487,II1920C +488,WI1924C +489,PI1925IC +490,TIA1925OC +491,PI1925OC +492,ZI1926C +493,II1926C +494,ZI19262C +495,PI1924ZC +496,PI1924YC +497,LI1924ZC +498,LI1924YC +499,TIA1929AC +500,TIA1929AZC +501,PI1929IC +502,II1929C +503,PI1929OC +504,TIA1929BC +505,TIA1929BZC +506,II1940C +507,PI1939OC +508,ZI1940C +509,ZI19261C +510,ZI1933C +511,PI1933IC +512,SI1933C +513,II1933C +514,II1931C +515,TIA1933OC +516,PI1934IC +517,PI1934OC +518,ZI1935C +519,II1935C +520,II1943C +521,LIA19491C +522,LIA19493C +523,LIA19495C +524,A2915 +525,A2916 +526,A2917 +527,A2918 +528,A2919 +529,A2920 +530,A2921 +531,ZF2922 +532,A2926 +533,A2929 +534,A2929B +535,A2927 +536,A2928 +537,A2929A +538,ZF29392 +539,A2939 +540,A2940 +541,A2933 +542,A2931 +543,A2934 +544,A2935 +545,A2943 +546,LIA17211C +547,LIA19151C +548,LIA19161C +549,LIA19171C +550,II2919C +551,SumFICementB +552,FI2915C +553,FI2916C +554,FI2917C +555,FI2918C +556,FI2914C +557,Total2915 +558,Total2916 +559,Total2917 +560,Total2918 +561,Total2914 +562,TotalCementB +563,II2920C +564,WI2924C +565,PI2925IC +566,TIA2925OC +567,PI2925OC +568,ZI2926C +569,II2926C +570,ZI29262C +571,PI2924ZC +572,PI2924YC +573,LI2924ZC +574,LI2924YC +575,TIA2929AC +576,TIA2929AZC +577,PI2929IC +578,II2929C +579,PI2929OC +580,TIA2929BC +581,TIA2929BZC +582,II2940C +583,PI2939OC +584,ZI2940C +585,ZI29261C +586,ZI2933C +587,PI2933IC +588,SI2933C +589,II2933C +590,II2931C +591,PI2934IC +592,PI2934OC +593,ZI2935C +594,II2935C +595,II2943C +596,LIA19492C +597,LIA19494C +598,LIA19496C +599,A1618 +600,A1327 +601,A1309 +602,A1506 +603,A1512 +604,A1538 +605,A1833 +606,A1804 +607,A1002 +608,A1222 +609,II1618C +610,II1327C +611,II1309C +612,II1506C +613,II1512C +614,II1538C +615,II1833C +616,II1804C +617,II1002C +618,II1222C +619,TIA1618C +620,TIA1327AC +621,TIA1327AC +622,TIA1506A1C +623,TIA1538C +624,TIA1538C +625,TIA1538C +626,TIA1804C +627,TIA1002ZC +628,TIA1222C +629,TIA1618C +630,TIA1327BC +631,TIA1327BC +632,TIA1506B1C +633,TIA1538C +634,TIA1538C +635,TIA1538C +636,TIA1804C +637,TIA1002ZC +638,TIA1222C +639,TIA1618C +640,TIA1327CC +641,TIA1327CC +642,TIA1506C1C +643,TIA1538C +644,TIA1538C +645,TIA1538C +646,TIA1804C +647,TIA1002ZC +648,TIA1222C +649,TIA1618Z1C +650,TIA1327Z1C +651,TIA1309Z1C +652,TIA1506Z1C +653,TIA1538Z1C +654,TIA1833Z1C +655,TIA1804ZC +656,TIA1002Z1C +657,TIA1222Z1C +658,TIA1618Z1C +659,TIA1327Z2C +660,TIA1309Z1C +661,TIA1506Z2C +662,TIA1538Z1C +663,TIA1833Z2C +664,TIA1804ZC +665,TIA1002Z1C +666,TIA1222Z2C +667,TIA1618Z2C +668,TIA1327Z3C +669,TIA1506Z3C +670,TIA1538Z2C +671,TIA1833C +672,TIA1833C +673,TIA1833C +674,TIA1618Z2C +675,TIA1327Z4C +676,TIA1506Z4C +677,TIA1538Z2C +678,TIA1833C +679,TIA1833C +680,TIA1833C +681,TIA1833C +682,A1929 +683,A1926 +684,A1935 +685,A2929 +686,A2926 +687,A2935 +688,II1929C +689,II1926C +690,II1935C +691,II2929C +692,II2926C +693,II2935C +694,TIA1929C +695,TIA1926C +696,TIA1935C +697,TIA2929C +698,TIA2926C +699,TIA2935C +700,TIA1929Z1C +701,TIA1926Z1C +702,TIA1935Z1C +703,TIA2929Z1C +704,TIA2926Z1C +705,TIA2935Z1C +706,TIA1929Z1C +707,TIA1926Z2C +708,TIA1935Z2C +709,TIA2929Z1C +710,TIA2926Z2C +711,TIA2935Z2C +712,FI142311 +713,II1401C +714,ZF1430 +715,ZR1430 +716,ZF1429 +717,ZR1429 +718,ZF18142 +719,ZR18142 +720,ZF18143 +721,ZR18143 \ No newline at end of file diff --git a/Log.txt b/Log.txt new file mode 100644 index 0000000..0de70f5 --- /dev/null +++ b/Log.txt @@ -0,0 +1,6 @@ + + +2012-3-7 14:03:49Err on Saving ConfigFile + + +2012-3-7 14:04:29Err on Saving ConfigFile diff --git a/MSSCCPRJ.SCC b/MSSCCPRJ.SCC new file mode 100644 index 0000000..0d10d05 --- /dev/null +++ b/MSSCCPRJ.SCC @@ -0,0 +1,5 @@ +[SCC] +SCC=This is a source code control file +[VB_TCP_Modbus.vbp] +SCC_Project_Name=this project is not under source code control +SCC_Aux_Path= diff --git a/Method.bas b/Method.bas new file mode 100644 index 0000000..47aa608 --- /dev/null +++ b/Method.bas @@ -0,0 +1,51 @@ +Attribute VB_Name = "Method" +Option Base 1 +Public Const LB_FINDSTRING = &H18F +Public Const CB_FINDSTRINGEXACT = &H158 +Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long +Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long '判断数组为空 +Public Declare Function timeGetTime Lib "winmm.dll" () As Long '获取开机至今过去多少时间 +Public Declare Function timeBeginPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long '时间分辨率 +Public Declare Function timeEndPeriod Lib "winmm.dll" (ByVal uPeriod As Long) As Long +'写INI文件 +Public Function WriteFile_INI(Section As String, key As String, Value As String) As Boolean +Dim OpcFile As CIniFile +On Error GoTo ErrHandle +Set OpcFile = New CIniFile +OpcFile.SpecifyIni (App.Path + "\ModbusCfg.ini") +Dim msso As Boolean +msso = OpcFile.WriteString(Section, key, Value) +WriteFile_INI = msso +Exit Function + +ErrHandle: +MsgBox err.Description + "OPEN File" +End Function + + +'读取INI文件 +Public Function ReadFile_INI(Section As String, key As String) As String +Dim OpcFile As CIniFile +On Error GoTo ErrHandle +Set OpcFile = New CIniFile +OpcFile.SpecifyIni (App.Path + "\ModbusCfg.ini") +Dim msso As String +msso = OpcFile.ReadString(Section, key, 80) +ReadFile_INI = msso +Exit Function + +ErrHandle: +MsgBox err.Description + "OPEN File" +End Function + +'Log记录 + +Public Sub WriteLog(ErrStr As String) + +Open App.Path + "\Log.txt" For Append As #1 + 'Print #1, vbCrLf$ + Print #1, Now & ":" & ErrStr +Close #1 + +End Sub + diff --git a/ModbusCfg.ini b/ModbusCfg.ini new file mode 100644 index 0000000..3b0538b --- /dev/null +++ b/ModbusCfg.ini @@ -0,0 +1,25 @@ +[RealNum] +Count =11 +ConchReport +[NodeName] +name=127.0.0.1 + +[mssoapinit] +URLs="http://127.0.0.1:1206/BMCement/webservice.asmx?wsdl" +URL="http://192.168.1.12:8081/webservice.asmx?wsdl" + +[Configuration] +RemoteIP=127.0.0.1 +OPCServerIP=127.0.0.1 +LocalPort=502 +RemotePort=502 +ComStopBit=1 +ComCheck=None +ComBit=8 +ComBps=9600 +ComNumber=COM1 +combFunction=16 写多路寄存器 +combSlaveAddress=1 +txtDataAddress=0 +txtDataLen=1536 +HdbNum=50 diff --git a/ModbusData.xls b/ModbusData.xls new file mode 100644 index 0000000..4d361c4 Binary files /dev/null and b/ModbusData.xls differ diff --git a/OPCClass.cls b/OPCClass.cls new file mode 100644 index 0000000..e3996a7 --- /dev/null +++ b/OPCClass.cls @@ -0,0 +1,226 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "OPCClass" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +Option Explicit +Option Base 1 + +Private WithEvents objserver As opcserver '定义OPCSERVER +Attribute objserver.VB_VarHelpID = -1 +Private objGroups As OPCGroups '定义OPC组 +Private WithEvents objtestgrp As OPCGroup '使用的OPC组 +Attribute objtestgrp.VB_VarHelpID = -1 +Private objItems As OPCItems 'OPC项 +Private LServerHandles() As Long '服务器端返回的项目句柄，用于服务器端读写数据 +Private lTransID_Rd As Long '用于异步读取数据时区分完成的数据访问，由应用程序发行 +Private lCancelID_Rd As Long '服务端发行的用于取消访问的标识符 +Private lTransID_Wt As Long '识别完成的数据访问 +Private lCancelID_Wt As Long '用于取消正在访问中的数据 +Private Num_All As Integer '加入的项目总数 +'Private lServerState As Boolean '连接状态 +Public Event AsyncReadComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date, Errors() As Long) +Public Event DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date) +Public Event AsyncWriteComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, Errors() As Long) + + +Public Function Connect(ByVal strProgID As String, Optional strNode As String) As Boolean + On Error GoTo err + If objserver Is Nothing Then + ' 建立一个OPC服务器对象 + Set objserver = New opcserver + End If + + If objserver.ServerState = OPCDisconnected Then + ' 连接OPC服务器 + ' objserver.ServerState = opcconnected + objserver.Connect strProgID, strNode + End If + + If objGroups Is Nothing Then + ' 建立一个OPC组集合 + Set objGroups = objserver.OPCGroups + End If + + If objtestgrp Is Nothing Then + ' 添加一个OPC组 + Set objtestgrp = objGroups.Add("TestGrp") + End If + Connect = True + Exit Function +err: +Connect = False +MsgBox "无法连接到指定服务器", vbOKOnly +Disconnect +End Function +Public Sub Disconnect() + On Error Resume Next + ReDim lErrors(Num_All) As Long + + If Not objItems Is Nothing Then + If objItems.Count > 0 Then + ' 清除OPC项 + objItems.Remove Num_All, LServerHandles, lErrors + End If + Set objItems = Nothing + End If + + If Not objtestgrp Is Nothing Then + ' 清除OPC组 + objGroups.Remove "TestGrp" + objGroups.RemoveAll + Set objtestgrp = Nothing + End If + + If Not objGroups Is Nothing Then + Set objGroups = Nothing + End If + + If Not objserver Is Nothing Then + If objserver.ServerState <> OPCDisconnected Then + ' 断开OPC服务器. + objserver.Disconnect + End If + + Set objserver = Nothing + End If + +End Sub + +Public Sub AddItem(ByVal items As String, ByVal IsA As Boolean) + On Error GoTo err + Dim ItemID() As String + Dim i As Integer + ItemID() = Split(items, ",") + Num_All = UBound(ItemID) - LBound(ItemID) + 1 + ReDim strItemIDs(Num_All) As String + ReDim lClientHandles(Num_All) As Long + ReDim lErrors(Num_All) As Long + + + If objtestgrp Is Nothing Then + Exit Sub + End If + + If Not objItems Is Nothing Then + If objItems.Count > 0 Then + Exit Sub + End If + End If + + ' 设置组活动状态 + If IsA Then + objtestgrp.IsActive = True + Else + objtestgrp.IsActive = False + End If + ' 启动组非同期通知 + objtestgrp.IsSubscribed = True + + ' 建立OPC项集合 + Set objItems = objtestgrp.OPCItems + + + + ' 生成项标识符 + For i = 1 To Num_All + strItemIDs(i) = ItemID(i - 1) + lClientHandles(i) = i + Next i + ' 添加OPC项 + Call objItems.AddItems(Num_All, strItemIDs, _ + lClientHandles, LServerHandles, lErrors) + fmMain.Label3 = "加载成功！" + Exit Sub +err: +MsgBox "不能连接到指定的项", vbOKOnly +Disconnect +End Sub +Rem 读数据放在项目序列的前面，即从前面数读取多少个 +Public Sub AsyncRead() '(ByVal item_num As Long) + +' If item_num > Num_All Then +' item_num = Num_All +' End If + Dim item_num As Long + item_num = Num_All + ReDim lErrors(item_num) As Long + ReDim ServerHandles(item_num) As Long + Dim i As Integer + + If objtestgrp Is Nothing Then + Exit Sub + End If + + If objtestgrp.OPCItems.Count > 0 Then + ' 非同期读取 + lTransID_Rd = lTransID_Rd + 1 + + For i = 1 To item_num + ServerHandles(i) = LServerHandles(i) + Next i + + objtestgrp.AsyncRead item_num, ServerHandles, _ + lErrors, lTransID_Rd, lCancelID_Rd + End If + +End Sub +Rem 写数据放在项目序列的后面，即从后面数写入多少个，写入顺序为正序 +Public Sub AsyncWrite(ByRef vtItemValues() As Variant) + Dim item_num As Integer + item_num = UBound(vtItemValues) - LBound(vtItemValues) + 1 + If item_num > Num_All Then + item_num = Num_All + End If + + ReDim lHandle(item_num) As Long + Dim i As Integer + ReDim lErrors(item_num) As Long + If objtestgrp Is Nothing Then + Exit Sub + End If + + If objtestgrp.OPCItems.Count > 0 Then + For i = 1 To item_num + lHandle(i) = LServerHandles(i + Num_All - item_num) + Next i + + ' 非同期写入 + lTransID_Wt = lTransID_Wt + 1 + objtestgrp.AsyncWrite item_num, lHandle(), vtItemValues, _ + lErrors, lTransID_Wt, lCancelID_Wt + End If + +End Sub +Public Function GetOPCServers(Optional Node As String) As Variant + On Error GoTo lal + Dim i As Integer + Dim opcs As opcserver + Set opcs = New opcserver + GetOPCServers = opcs.GetOPCServers(Node) + Set opcs = Nothing + Exit Function +lal: + fmMain.Label3 = Now & "--" & err.Description +End Function + + + +Private Sub objtestgrp_AsyncReadComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date, Errors() As Long) +RaiseEvent AsyncReadComplete(TransactionID, NumItems, ClientHandles(), ItemValues(), Qualities(), TimeStamps(), Errors()) +End Sub + +Private Sub objtestgrp_AsyncWriteComplete(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, Errors() As Long) +RaiseEvent AsyncWriteComplete(TransactionID, NumItems, ClientHandles(), Errors()) +End Sub +Private Sub objtestgrp_DataChange(ByVal TransactionID As Long, ByVal NumItems As Long, ClientHandles() As Long, ItemValues() As Variant, Qualities() As Long, TimeStamps() As Date) +RaiseEvent DataChange(TransactionID, NumItems, ClientHandles(), ItemValues(), Qualities(), TimeStamps()) +End Sub diff --git a/OPC_CONF.bak b/OPC_CONF.bak new file mode 100644 index 0000000..73ae69a --- /dev/null +++ b/OPC_CONF.bak @@ -0,0 +1,728 @@ +No,Tag,TagName, +1,A1001 +2,A1002 +3,A1003 +4,A1007 +5,A1012 +6,A1201 +7,A1202 +8,A12211 +9,A12212 +10,A1222 +11,A1223 +12,A1226 +13,A1228 +14,D12281 +15,II1001C +16,II1002C +17,II1003C,PC_STARTA +18,SI1007C, +19,II1007C, +20,II1201C, +21,II1222C, +22,II1223C, +23,A1301, +24,A13021, +25,A13022, +26,A13031, +27,A13032, +28,A13041, +29,A13042, +30,A1306, +31,A1317, +32,ZR13181, +33,ZR1307 +34,A1308 +35,A1319 +36,ZF1321 +37,A1313 +38,A1309 +39,A1310 +40,A1311 +41,A1312 +42,A1315 +43,A1616 +44,A1615 +45,A1401 +46,ZR1402 +47,A1607 +48,A16064 +49,A16063 +50,A16062 +51,A16061 +52,A1327 +53,A16041 +54,A16042 +55,A1618 +56,LIA1301C +57,LIA1302C +58,LIA1303C +59,LIA1304C +60,II13021C +61,II13031C +62,II13041C +63,SumFIRaw +64,FI1301C +65,FI13022C +66,FI13032C +67,FI13042C +68,Total1301 +69,Total13022 +70,Total13032 +71,Total13042 +72,TotalRaw +73,TotalRaw +74,TotalRaw +75,TotalRaw +76,RUNDAYM1309 +77,RUNTIMEM1309 +78,II1317C +79,II1306C +80,LIA1318C +81,TIA13091C +82,PI1309IC +83,TIA1309IC +84,XIA13093C +85,XIA13094C +86,XIA13091C +87,XIA13092C +88,TIA1309Z1C +89,TIA1309C +90,PI13111C +91,PI13112C +92,II1309C +93,LIA13091C +94,LIA13092C +95,LIA13093C +96,PT1309C +97,SI1315C +98,II1315C +99,PI1309OC +100,TIA1309OC +101,ZI1326C +102,PI1330C +103,PI1327IC +104,ZI1327C +105,ZI1322C +106,ZI1321C +107,ZI1325C +108,ZI1604C +109,ZI1324C +110,PI1327OC +111,TIA1327OC +112,II1327C +113,PI1604AIC +114,TIA1604AIC +115,PI1604BIC +116,TIA1604BIC +117,PI1604Ad +118,PI1604Bd +119,CO_15041C +120,PI1604AOC +121,PI1604BOC +122,II1618C +123,ZI1618C +124,LIA1401C +125,A11011 +126,A11012 +127,A1102 +128,A1103 +129,D11031 +130,A1104 +131,A1105 +132,A1106 +133,A1107 +134,A1801 +135,A1812 +136,A1804 +137,A1810 +138,A1832 +139,A1832 +140,A1832 +141,A1832 +142,A1832 +143,A1832 +144,AR1813 +145,AF1813 +146,A1833 +147,FI11011C +148,FI11012C +149,Total11011 +150,Total11012 +151,II1102C +152,II1103C +153,II1105C +154,II1106C +155,II1107C +156,LIA1801C +157,FI1801C +158,Total1801 +159,ZI18041C +160,ZI18042C +161,TIA1804IC +162,PI1804IC +163,TIA1809BC +164,II1804C +165,TIA1809AC +166,TIA1804C +167,TIA1804ZC +168,NIA1804C +169,TIA1806C +170,TIA1804OC +171,PI1804OC +172,II1810C +173,SI1810C +174,TIA1810C +175,PI1810C +176,PI1832IC +177,ANA3_COC +178,PIA1832C +179,PI1832OC +180,TIA1832OC +181,ZI1833C +182,II1833C +183,XIA1833C +184,ANA4_COC +185,WIA1823C +186,WIA1824C +187,FI1823C +188,FI1824C +189,A1506 +190,A14281 +191,A14282 +192,A1521 +193,A1522 +194,A1512 +195,A15121 +196,A1515 +197,A15131 +198,A1519 +199,A1520 +200,A1523 +201,A15301 +202,A15302 +203,A15303 +204,A15304 +205,A15305 +206,A15306 +207,A15307 +208,A15308 +209,A15311 +210,A15312 +211,Ack15313 +212,Ack15321 +213,Ack15322 +214,Ack15323 +215,Ack15331 +216,Ack15332 +217,Ack15333 +218,A1703 +219,A15281 +220,A15282 +221,A15283 +222,A1529 +223,A14143 +224,A14142 +225,A14141 +226,A1825 +227,A1826 +228,A1827 +229,A1828 +230,A14231 +231,A14232 +232,A1823 +233,A1824 +234,O2_15041C +235,CO_15041C +236,SO2_15041C +237,NOX_15041C +238,II1506C +239,SI1506C +240,XIA15061C +241,XIA15062C +242,TIA1601IC +243,PI1601C +244,TIA1601OC +245,FI1609C +246,O2_15043C +247,CO_15043C +248,NOX_15043C +249,O2_15042C +250,CO_15042C +251,NOX_15042C +252,TIA1506IC +253,PI1506IC +254,TIA1502B2C +255,PI1502B2C +256,TIA1502B1C +257,PI1502B1C +258,TIA1502A2C +259,PI1502A2C +260,TIA1502A1C +261,PI1502A1C +262,TIA1503B2C +263,PI1503B2C +264,TIA1503B1C +265,PI1503B1C +266,TIA1504BC +267,PI1504BC +268,TIA1504AC +269,PI1504AC +270,TIA1503A2C +271,PI1503A2C +272,TIA1503A1C +273,PI1503A1C +274,TIA1506BC +275,PI1506BC +276,TIA1505BC +277,PI1505BC +278,TIA1505AC +279,PI1505AC +280,TIA1506AC +281,PI1506AC +282,TIA1507BC +283,PI1507BC +284,TIA1508BC +285,PI1508BC +286,TIA1508AC +287,PI1508AC +288,TIA1507AC +289,PI1507AC +290,TIA1510BC +291,PI1510BC +292,TIA1509BC +293,PI1509BC +294,TIA1509AC +295,PI1509AC +296,TIA1510AC +297,PI1510AC +298,TIA1511BC +299,PI1511BC +300,TIA1512BC +301,PI1512BC +302,TIA1512AC +303,PI1512AC +304,TIA1511AC +305,PI1511AC +306,TIA1514C +307,PI1514C +308,II1521C +309,TIA1515C +310,PI1515C +311,SI1512C +312,II1512C +313,TIA15121C +314,TIA15122C +315,TIA15123C +316,PI1520C +317,TIA1535C +318,II14143C +319,II14142C +320,II14141C +321,II1825C +322,II1826C +323,II1827C +324,II1828C +325,FI1823C +326,FI1824C +327,WIA1823C +328,WIA1824C +329,FI14231C +330,FI14232C +331,ZI14211C +332,ZI14221C +333,WIA1423C +334,Total1423 +335,LIA1401C +336,II14281C +337,II14282C +338,Ack1527 +339,A15271 +340,A15281 +341,A15282 +342,A15283 +343,A15301 +344,A15302 +345,A15303 +346,A15304 +347,A15305 +348,A15306 +349,A15311 +350,A15312 +351,Ack15313 +352,A15307 +353,A15308 +354,Ack15321 +355,Ack15322 +356,Ack15323 +357,Ack15331 +358,Ack15332 +359,Ack15333 +360,A1529 +361,A1534 +362,A15362 +363,A15361 +364,A15359 +365,A15357 +366,A15355 +367,A15353 +368,A15351 +369,A15352 +370,A15354 +371,A15356 +372,A15358 +373,A1537 +374,A15371 +375,A15374 +376,A15372 +377,A15375 +378,A15373 +379,A15376 +380,A15391 +381,A15392 +382,A1540 +383,A1703 +384,ZR17011 +385,ZR17012 +386,ZR17024 +387,A1701 +388,A1538 +389,SI1527C +390,PI1527C +391,II1527C +392,PI1520C +393,TIA1535C +394,TIA1528L1C +395,TIA1528L2C +396,TIA1528R1C +397,TIA1528R2C +398,II1528aC +399,SI15281C +400,II1528bC +401,SI15282C +402,II1528cC +403,SI15283C +404,II1528dC +405,II1529C +406,TIA15285C +407,PI1528aC +408,PI1528bC +409,PI1528cC +410,PI1528dC +411,PI1528eC +412,PI1528fC +413,PI1528gC +414,PI1528hC +415,PI1528iC +416,TIA1529ZC +417,II15301C +418,II15302C +419,II15303C +420,II15304C +421,II15305C +422,II15306C +423,II15311C +424,II15312C +425,II15313C +426,II15307C +427,II15308C +428,II15321C +429,II15322C +430,II15323C +431,II15331C +432,II15332C +433,II15333C +434,ZI1539C +435,PI1537C +436,TIA1537IC +437,PI1542OC +438,TIA1542OC +439,PI1538C +440,ZI1538C +441,II1538C +442,XIA15381C +443,XIA15382C +444,II1703C +445,II1701C +446,LIA1701C +447,LIA1702C +448,A1915 +449,A1916 +450,A1917 +451,A1918 +452,A1919 +453,A1920 +454,A1921 +455,ZF1922 +456,A1926 +457,A1929 +458,A1927 +459,A1928 +460,A1929B +461,A1929A +462,ZF19392 +463,A1939 +464,A1940 +465,A1933 +466,A1931 +467,A1934 +468,A1935 +469,A1943 +470,LIA17211C +471,LIA19151C +472,LIA19161C +473,LIA19171C +474,II1919C +475,SumFICementA +476,FI1915C +477,FI1916C +478,FI1917C +479,FI1918C +480,FI1914C +481,Total1915 +482,Total1916 +483,Total1917 +484,Total1918 +485,Total1914 +486,TotalCementA +487,II1920C +488,WI1924C +489,PI1925IC +490,TIA1925OC +491,PI1925OC +492,ZI1926C +493,II1926C +494,ZI19262C +495,PI1924ZC +496,PI1924YC +497,LI1924ZC +498,LI1924YC +499,TIA1929AC +500,TIA1929AZC +501,PI1929IC +502,II1929C +503,PI1929OC +504,TIA1929BC +505,TIA1929BZC +506,II1940C +507,PI1939OC +508,ZI1940C +509,ZI19261C +510,ZI1933C +511,PI1933IC +512,SI1933C +513,II1933C +514,II1931C +515,TIA1933OC +516,PI1934IC +517,PI1934OC +518,ZI1935C +519,II1935C +520,II1943C +521,LIA19491C +522,LIA19493C +523,LIA19495C +524,A2915 +525,A2916 +526,A2917 +527,A2918 +528,A2919 +529,A2920 +530,A2921 +531,ZF2922 +532,A2926 +533,A2929 +534,A2929B +535,A2927 +536,A2928 +537,A2929A +538,ZF29392 +539,A2939 +540,A2940 +541,A2933 +542,A2931 +543,A2934 +544,A2935 +545,A2943 +546,LIA17211C +547,LIA19151C +548,LIA19161C +549,LIA19171C +550,II2919C +551,SumFICementB +552,FI2915C +553,FI2916C +554,FI2917C +555,FI2918C +556,FI2914C +557,Total2915 +558,Total2916 +559,Total2917 +560,Total2918 +561,Total2914 +562,TotalCementB +563,II2920C +564,WI2924C +565,PI2925IC +566,TIA2925OC +567,PI2925OC +568,ZI2926C +569,II2926C +570,ZI29262C +571,PI2924ZC +572,PI2924YC +573,LI2924ZC +574,LI2924YC +575,TIA2929AC +576,TIA2929AZC +577,PI2929IC +578,II2929C +579,PI2929OC +580,TIA2929BC +581,TIA2929BZC +582,II2940C +583,PI2939OC +584,ZI2940C +585,ZI29261C +586,ZI2933C +587,PI2933IC +588,SI2933C +589,II2933C +590,II2931C +591,PI2934IC +592,PI2934OC +593,ZI2935C +594,II2935C +595,II2943C +596,LIA19492C +597,LIA19494C +598,LIA19496C +599,A1618 +600,A1327 +601,A1309 +602,A1506 +603,A1512 +604,A1538 +605,A1833 +606,A1804 +607,A1002 +608,A1222 +609,II1618C +610,II1327C +611,II1309C +612,II1506C +613,II1512C +614,II1538C +615,II1833C +616,II1804C +617,II1002C +618,II1222C +619,TIA1618C +620,TIA1327AC +621,TIA1327AC +622,TIA1506A1C +623,TIA1538C +624,TIA1538C +625,TIA1538C +626,TIA1804C +627,TIA1002ZC +628,TIA1222C +629,TIA1618C +630,TIA1327BC +631,TIA1327BC +632,TIA1506B1C +633,TIA1538C +634,TIA1538C +635,TIA1538C +636,TIA1804C +637,TIA1002ZC +638,TIA1222C +639,TIA1618C +640,TIA1327CC +641,TIA1327CC +642,TIA1506C1C +643,TIA1538C +644,TIA1538C +645,TIA1538C +646,TIA1804C +647,TIA1002ZC +648,TIA1222C +649,TIA1618Z1C +650,TIA1327Z1C +651,TIA1309Z1C +652,TIA1506Z1C +653,TIA1538Z1C +654,TIA1833Z1C +655,TIA1804ZC +656,TIA1002Z1C +657,TIA1222Z1C +658,TIA1618Z1C +659,TIA1327Z2C +660,TIA1309Z1C +661,TIA1506Z2C +662,TIA1538Z1C +663,TIA1833Z2C +664,TIA1804ZC +665,TIA1002Z1C +666,TIA1222Z2C +667,TIA1618Z2C +668,TIA1327Z3C +669,TIA1506Z3C +670,TIA1538Z2C +671,TIA1833C +672,TIA1833C +673,TIA1833C +674,TIA1618Z2C +675,TIA1327Z4C +676,TIA1506Z4C +677,TIA1538Z2C +678,TIA1833C +679,TIA1833C +680,TIA1833C +681,TIA1833C +682,A1929 +683,A1926 +684,A1935 +685,A2929 +686,A2926 +687,A2935 +688,II1929C +689,II1926C +690,II1935C +691,II2929C +692,II2926C +693,II2935C +694,TIA1929C +695,TIA1926C +696,TIA1935C +697,TIA2929C +698,TIA2926C +699,TIA2935C +700,TIA1929Z1C +701,TIA1926Z1C +702,TIA1935Z1C +703,TIA2929Z1C +704,TIA2926Z1C +705,TIA2935Z1C +706,TIA1929Z1C +707,TIA1926Z2C +708,TIA1935Z2C +709,TIA2929Z1C +710,TIA2926Z2C +711,TIA2935Z2C +712,FI142311 +713,II1401C +714,ZF1430 +715,ZR1430 +716,ZF1429 +717,ZR1429 +718,ZF18142 +719,ZR18142 +720,ZF18143 +721,ZR18143test +test +test +test +test +test +test diff --git a/OPC_CONF.csv b/OPC_CONF.csv new file mode 100644 index 0000000..cab310c --- /dev/null +++ b/OPC_CONF.csv @@ -0,0 +1,11 @@ +No,Tag,TagName +1,numeric.random.int8 +2,numeric.random.int16 +3,numeric.random.int32 +4,numeric.random.uint64 +5,numeric.random.int8 +6,numeric.random.int8 +7,numeric.random.int8 +8,numeric.random.int8 +9,numeric.random.int8 +10,numeric.random.int8 diff --git a/PublicMod.bas b/PublicMod.bas new file mode 100644 index 0000000..ed114f5 --- /dev/null +++ b/PublicMod.bas @@ -0,0 +1,35 @@ +Attribute VB_Name = "PublicMod" +Public OpenFlag As Boolean +Public ConnectFlag As Boolean +Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long) +Public Function Hexn(ByVal number As Long, ByVal n As Integer) As String +Dim str As String + + str = String(n, "0") + Hex(number) + str = Right(str, n) + Hexn = str +End Function + + +Function Crc_16(ByVal Str1 As String) As Long +Dim i As Integer +Dim j As Integer +Dim CVal As Long +Dim Temp1 As Integer +Dim Const1 As Long + CVal = 65535 '&HFFFF + Const1 = 40961 '&HA001 + For i = 1 To LenB(Str1) + Temp1 = AscB(MidB(Str1, i, 1)) + CVal = Temp1 Xor CVal + For j = 0 To 7 + If (CVal Mod 2) = 0 Then + CVal = CVal \ 2 + Else + CVal = CVal \ 2 + CVal = CVal Xor Const1 + End If + Next j + Next i + Crc_16 = CVal And &HFFFF& +End Function diff --git a/VB_Modbus.frm b/VB_Modbus.frm new file mode 100644 index 0000000..e7eb1b2 --- /dev/null +++ b/VB_Modbus.frm @@ -0,0 +1,1556 @@ +VERSION 5.00 +Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "Mswinsck.OCX" +Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX" +Object = "{648A5603-2C6E-101B-82B6-000000000014}#1.1#0"; "MSCOMM32.OCX" +Begin VB.Form fmMain + Caption = "Modbus RTU/TCP协议 客户端-Mister.T" + ClientHeight = 9465 + ClientLeft = 60 + ClientTop = 645 + ClientWidth = 16335 + BeginProperty Font + Name = "Tahoma" + Size = 9 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Icon = "VB_Modbus.frx":0000 + LinkTopic = "Form1" + MaxButton = 0 'False + ScaleHeight = 9465 + ScaleWidth = 16335 + StartUpPosition = 2 '屏幕中心 + Begin VB.Timer tmUpdate + Enabled = 0 'False + Interval = 1000 + Left = 0 + Top = 0 + End + Begin VB.CommandButton btnRefresh + Caption = "Refresh" + Height = 495 + Left = 5520 + TabIndex = 38 + Top = 1800 + Width = 1695 + End + Begin VB.CommandButton btnOPC + Caption = "Connect" + Height = 495 + Left = 5520 + TabIndex = 37 + Top = 2400 + Width = 1695 + End + Begin VB.Frame Frame1 + Caption = "OPCServer Interface" + Height = 2775 + Left = 120 + TabIndex = 31 + Top = 240 + Width = 7455 + Begin VB.CheckBox DataChgChk + Caption = "启用订阅数据更新" + Height = 375 + Left = 5400 + TabIndex = 41 + Top = 600 + Width = 1815 + End + Begin VB.ComboBox Combo1 + Height = 330 + Left = 1320 + TabIndex = 39 + Top = 1590 + Width = 3495 + End + Begin VB.TextBox txtOPCAddress + BackColor = &H0080FFFF& + Height = 375 + Left = 1320 + Locked = -1 'True + TabIndex = 32 + Text = "127.0.0.1" + Top = 600 + Width = 2295 + End + Begin VB.Label Label7 + AutoSize = -1 'True + Caption = "OPCServer Name" + BeginProperty Font + Name = "Tahoma" + Size = 12 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00C00000& + Height = 285 + Index = 2 + Left = 3000 + TabIndex = 33 + Top = 1080 + Width = 1830 + End + Begin VB.Label Label7 + AutoSize = -1 'True + Caption = "OPCServer Address" + BeginProperty Font + Name = "Tahoma" + Size = 12 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00C00000& + Height = 285 + Index = 4 + Left = 2880 + TabIndex = 34 + Top = 120 + Width = 2070 + End + Begin VB.Line Line1 + BorderColor = &H80000001& + Index = 5 + X1 = -120 + X2 = 7440 + Y1 = 1200 + Y2 = 1200 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "IP Address" + Height = 210 + Index = 4 + Left = 240 + TabIndex = 36 + Top = 690 + Width = 870 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "OPC Name" + Height = 210 + Index = 2 + Left = 240 + TabIndex = 35 + Top = 1650 + Width = 870 + End + Begin VB.Line Line1 + BorderColor = &H80000001& + Index = 4 + X1 = 0 + X2 = 7440 + Y1 = 240 + Y2 = 240 + End + End + Begin VB.CommandButton btnTCP + Caption = "Listen" + Height = 495 + Left = 14040 + TabIndex = 30 + Top = 2400 + Width = 1695 + End + Begin MSCommLib.MSComm MSComPort + Left = 11400 + Top = 7200 + _ExtentX = 1005 + _ExtentY = 1005 + _Version = 393216 + DTREnable = -1 'True + End + Begin VB.Frame FrameCom + Caption = "COM Interface" + Height = 2775 + Left = 7680 + TabIndex = 17 + Top = 3120 + Width = 8295 + Begin VB.CommandButton btnOpenPort + Caption = "Open Port" + Height = 495 + Left = 6360 + TabIndex = 29 + Top = 1440 + Width = 1695 + End + Begin VB.ComboBox StopCb + BeginProperty Font + Name = "Tahoma" + Size = 9.75 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 360 + Left = 6600 + Style = 2 'Dropdown List + TabIndex = 24 + Top = 600 + Width = 1455 + End + Begin VB.ComboBox DataCb + BeginProperty Font + Name = "Tahoma" + Size = 9.75 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 360 + Left = 3915 + Style = 2 'Dropdown List + TabIndex = 23 + Top = 1560 + Width = 1455 + End + Begin VB.ComboBox CheckCb + BeginProperty Font + Name = "Tahoma" + Size = 9.75 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 360 + Left = 3915 + Style = 2 'Dropdown List + TabIndex = 22 + Top = 600 + Width = 1455 + End + Begin VB.ComboBox RateCb + BeginProperty Font + Name = "Tahoma" + Size = 9.75 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 360 + Left = 1200 + Style = 2 'Dropdown List + TabIndex = 21 + Top = 1560 + Width = 1455 + End + Begin VB.ComboBox PortCb + BeginProperty Font + Name = "Tahoma" + Size = 9.75 + Charset = 0 + Weight = 700 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 360 + Left = 1200 + Style = 2 'Dropdown List + TabIndex = 20 + Top = 600 + Width = 1455 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "Stop Bit:" + Height = 195 + Index = 8 + Left = 5595 + TabIndex = 28 + Top = 690 + Width = 840 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "Data Bit:" + Height = 255 + Index = 7 + Left = 2760 + TabIndex = 27 + Top = 1680 + Width = 855 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "Check Way:" + Height = 195 + Index = 6 + Left = 2760 + TabIndex = 26 + Top = 690 + Width = 1080 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "Baud Rate:" + Height = 255 + Index = 5 + Left = 120 + TabIndex = 25 + Top = 1680 + Width = 1095 + End + Begin VB.Label Label7 + AutoSize = -1 'True + Caption = "Local Setting" + BeginProperty Font + Name = "Tahoma" + Size = 12 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00C00000& + Height = 285 + Index = 3 + Left = 3360 + TabIndex = 18 + Top = 120 + Width = 1350 + End + Begin VB.Line Line1 + BorderColor = &H80000001& + Index = 3 + X1 = 0 + X2 = 8280 + Y1 = 1200 + Y2 = 1200 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "COM Port:" + Height = 210 + Index = 3 + Left = 120 + TabIndex = 19 + Top = 690 + Width = 1095 + End + Begin VB.Line Line1 + BorderColor = &H80000001& + Index = 2 + X1 = 0 + X2 = 8280 + Y1 = 240 + Y2 = 240 + End + End + Begin VB.Frame Frame2 + Caption = "Server Data" + Height = 6255 + Left = 120 + TabIndex = 5 + Top = 3120 + Width = 7455 + Begin VB.CommandButton btnReadExcel + Caption = "Read from Excel" + Height = 495 + Left = 2160 + TabIndex = 16 + Top = 5640 + Width = 1695 + End + Begin VB.CommandButton btnWriteExcel + Caption = "Write to Excel" + Height = 495 + Left = 3960 + TabIndex = 15 + Top = 5640 + Width = 1575 + End + Begin VB.CommandButton btnExit + Caption = "Exit" + Height = 495 + Left = 5640 + TabIndex = 14 + Top = 5640 + Width = 1695 + End + Begin VB.TextBox txtAutoData + BeginProperty Font + Name = "宋体" + Size = 9 + Charset = 134 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + Height = 375 + Left = 5640 + TabIndex = 13 + Text = "Text1" + Top = 480 + Width = 1335 + End + Begin MSFlexGridLib.MSFlexGrid MSFlexGrid2 + Height = 5175 + Left = 120 + TabIndex = 12 + Top = 360 + Width = 7215 + _ExtentX = 12726 + _ExtentY = 9128 + _Version = 393216 + End + End + Begin VB.Frame FrameTCP + Caption = "TCP Interface" + Height = 2775 + Left = 7680 + TabIndex = 0 + Top = 240 + Width = 8295 + Begin VB.TextBox txtIPPort + Height = 375 + Index = 1 + Left = 5760 + TabIndex = 9 + Text = "502" + Top = 1560 + Width = 1095 + End + Begin VB.TextBox txtIPAddress + Height = 375 + Index = 1 + Left = 1320 + TabIndex = 7 + Text = "127.0.0.1" + Top = 1560 + Width = 2295 + End + Begin VB.TextBox txtIPPort + Height = 375 + Index = 0 + Left = 5760 + TabIndex = 4 + Text = "502" + Top = 600 + Width = 1095 + End + Begin VB.TextBox txtIPAddress + BackColor = &H0080FFFF& + Height = 375 + Index = 0 + Left = 1320 + Locked = -1 'True + TabIndex = 2 + Text = "127.0.0.1" + Top = 600 + Width = 2295 + End + Begin VB.Label Label7 + AutoSize = -1 'True + Caption = "Remote Setting" + BeginProperty Font + Name = "Tahoma" + Size = 12 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00C00000& + Height = 285 + Index = 1 + Left = 2760 + TabIndex = 11 + Top = 1080 + Width = 1620 + End + Begin VB.Label Label7 + AutoSize = -1 'True + Caption = "Local Setting" + BeginProperty Font + Name = "Tahoma" + Size = 12 + Charset = 0 + Weight = 400 + Underline = 0 'False + Italic = 0 'False + Strikethrough = 0 'False + EndProperty + ForeColor = &H00C00000& + Height = 285 + Index = 0 + Left = 2880 + TabIndex = 10 + Top = 120 + Width = 1350 + End + Begin VB.Line Line1 + BorderColor = &H80000001& + Index = 0 + X1 = 0 + X2 = 8280 + Y1 = 240 + Y2 = 240 + End + Begin VB.Label Label2 + AutoSize = -1 'True + Caption = "IP Port" + Height = 210 + Index = 1 + Left = 4920 + TabIndex = 8 + Top = 1650 + Width = 570 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "IP Address" + Height = 210 + Index = 1 + Left = 240 + TabIndex = 6 + Top = 1650 + Width = 870 + End + Begin VB.Label Label2 + AutoSize = -1 'True + Caption = "IP Port" + Height = 210 + Index = 0 + Left = 4920 + TabIndex = 3 + Top = 690 + Width = 570 + End + Begin VB.Label Label1 + AutoSize = -1 'True + Caption = "IP Address" + Height = 210 + Index = 0 + Left = 240 + TabIndex = 1 + Top = 690 + Width = 870 + End + Begin VB.Line Line1 + BorderColor = &H80000001& + Index = 1 + X1 = -120 + X2 = 8280 + Y1 = 1200 + Y2 = 1200 + End + End + Begin VB.Timer Timer1 + Enabled = 0 'False + Interval = 1000 + Left = 11520 + Top = 8640 + End + Begin MSWinsockLib.Winsock Wsk_Server + Index = 0 + Left = 11520 + Top = 8040 + _ExtentX = 741 + _ExtentY = 741 + _Version = 393216 + End + Begin VB.Label Label3 + Caption = "Label3" + Height = 735 + Left = 7920 + TabIndex = 40 + Top = 6120 + Width = 8055 + End + Begin VB.Menu 菜单 + Caption = "&File" + Begin VB.Menu Import_Cfg + Caption = "&ImportConfig" + End + Begin VB.Menu ImportItems + Caption = "&ImportItems" + End + Begin VB.Menu Exit + Caption = "&Exit" + End + End + Begin VB.Menu Config + Caption = "&Config" + Begin VB.Menu TCP_Param + Caption = "&Tcp" + End + Begin VB.Menu Rtu_Param + Caption = "&Rtu" + End + End + Begin VB.Menu Winsock_Start + Caption = "TcpStart" + End + Begin VB.Menu COM_Start + Caption = "COMStart" + End +End +Attribute VB_Name = "fmMain" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +Option Explicit + +Private WithEvents opcserver As OPCClass +Attribute opcserver.VB_VarHelpID = -1 +Dim SubOPC As Boolean '启用订阅更新 + +Dim xlsFilePath As String +Dim InputS(), CoilS(), InputR(), HoldR(), rowLen, colLen +Dim ClientNum As Integer, lhostName As String +Dim i As Integer +Dim ComNumber, ComBit, ComBps, ComStopBit, ComCheck, RemoteIP, OPCServerIP, LocalPort, RemotePort As String +Dim CSVP As New CSVParse + +'Public Declare Function SafeArrayGetDim Lib "oleaut32.dll" (ByRef saArray() As Any) As Long '判断数组为空 + + +'----------【导入配置文件】---------- +Private Sub ImportCfgFile() + + TagSum = CInt(ReadFile_INI("RealNum", "Count")) + ComNumber = ReadFile_INI("Configuration", "ComNumber") + ComBit = ReadFile_INI("Configuration", "ComBit") + ComBps = ReadFile_INI("Configuration", "ComBps") + ComStopBit = ReadFile_INI("Configuration", "ComStopBit") + ComCheck = ReadFile_INI("Configuration", "ComCheck ") + RemoteIP = ReadFile_INI("Configuration", "RemoteIP ") + LocalPort = ReadFile_INI("Configuration", "LocalPort ") + RemotePort = ReadFile_INI("Configuration", "RemotePort ") + OPCServerIP = ReadFile_INI("Configuration", "OPCServerIP ") + + PortCb.ListIndex = SendMessage(PortCb.hwnd, CB_FINDSTRINGEXACT, -1, ByVal CStr(ComNumber)) + CheckCb.ListIndex = SendMessage(CheckCb.hwnd, CB_FINDSTRINGEXACT, -1, ByVal CStr(ComCheck)) + RateCb.ListIndex = SendMessage(RateCb.hwnd, CB_FINDSTRINGEXACT, -1, ByVal CStr(ComBps)) + DataCb.ListIndex = SendMessage(DataCb.hwnd, CB_FINDSTRINGEXACT, -1, ByVal CStr(ComBit)) + StopCb.ListIndex = SendMessage(StopCb.hwnd, CB_FINDSTRINGEXACT, -1, ByVal CStr(ComStopBit)) + + txtIPPort(0).Text = LocalPort + txtIPAddress(1).Text = RemoteIP + txtIPPort(1).Text = RemotePort + +End Sub + + + +Private Sub btnOPC_Click() +Set opcserver = New OPCClass + If opcserver.Connect(Combo1.Text, txtOPCAddress.Text) Then + + Dim Tag As String +'Dim Savetime As Double + + + ' tag = LvListView.ListItems(1).SubItems(1) + Tag = MSFlexGrid2.TextMatrix(1, 3) + For i = 2 To 11 + Tag = Tag & "," & MSFlexGrid2.TextMatrix(i, 3) + Next i + opcserver.AddItem Tag, SubOPC + +'Label1: +'opcserver.AsyncRead +'Dim Savetime As Double +'timeBeginPeriod 1 +'Savetime = timeGetTime +'While timeGetTime < Savetime + 2000 +'' If ss = True Then +'' timeEndPeriod 1 +'' opcserver.Disconnect +'' Set opcserver = Nothing +'' Exit Sub +'' End If +'DoEvents +'Wend +'GoTo Label1 + + + 'btnAddItem.Enabled = True + End If + +End Sub + +Private Sub btnRefresh_Click() +On Error Resume Next + Combo1.Clear + Dim i As Integer + Dim servername As Variant + Dim opcs As OPCClass + +Set opcs = New OPCClass + servername = opcs.GetOPCServers(txtOPCAddress.Text) +Set opcs = Nothing + For i = LBound(servername) To UBound(servername) + Combo1.AddItem servername(i), i - 1 + Next i +End Sub + + + +Private Sub DataChgChk_Click() + If DataChgChk.Value = vbChecked Then + tmUpdate.Enabled = False + SubOPC = True + Else + tmUpdate.Enabled = True + + SubOPC = False + + End If +End Sub + +Private Sub Import_Cfg_Click() +Call ImportCfgFile +End Sub + +'----------【导入变量文件】---------- +Private Sub ImportItems_Click() +ReDim Data(1 To TagSum) As TagData + CSVP.FileName = App.Path + "\OPC_CONF.csv" + CSVP.LoadNextLine + For i = 1 To TagSum + CSVP.LoadNextLine + Data(i).Tag = CSVP.GetField(2) + Data(i).TagName = CSVP.GetField(3) + +' Set itx = lvListView.ListItems.Add(, , CSVP.GetField(1)) +' itx.SubItems(1) = HourData(i).TagName +' itx.SubItems(3) = HourData(i).HH +' itx.SubItems(4) = HourData(i).LL + MSFlexGrid2.TextMatrix(i, 3) = Data(i).Tag + Next i + +Set CSVP = Nothing +End Sub +'----------OPC数据更新 +Private Sub opcserver_DataChange( _ + ByVal TransactionID As Long, ByVal NumItems As Long, _ + ClientHandles() As Long, ItemValues() As Variant, _ + Qualities() As Long, TimeStamps() As Date) + Dim strBuf As String + Dim nWidth As Integer + Dim nHeight As Integer + Dim nDrawHeight As Integer + Dim sglScale As Single + Dim i As Integer + + + For i = 1 To UBound(ItemValues) + + MSFlexGrid2.TextMatrix(i, 4) = ItemValues(i) + Next i + + + +End Sub +'----------【退出系统】---------- +Private Sub btnExit_Click() + + + End +End Sub + + +Private Sub btnOpenPort_Click() '打开串口 +Dim Settings As String +Dim j As Long +Dim SaveCfg As Boolean + +On Error GoTo ErrP + + Me.Caption = "Modbus Slave--COM" + If btnOpenPort.Caption = "Open Port" Then ''打开串口 + Select Case CheckCb.ListIndex + Case 0 + Settings = "N" + Case 1 + Settings = "O" + Case 2 + Settings = "E" + End Select + + Settings = RateCb.Text + "," + Settings + "," + DataCb.Text + "," + StopCb.Text + MSComPort.CommPort = PortCb.ListIndex + 1 + MSComPort.OutBufferSize = 1024 + MSComPort.InBufferSize = 1024 + MSComPort.InputMode = 1 + MSComPort.InputLen = 0 + MSComPort.InBufferCount = 0 + MSComPort.SThreshold = 1 + MSComPort.RThreshold = 1 + MSComPort.Settings = Settings + MSComPort.PortOpen = True + + If MSComPort.PortOpen = True Then + OpenFlag = True + Import_Cfg.Enabled = False + 'ComTimer.Enabled = True +'' Option2(0).Enabled = False +'' Option2(1).Enabled = False +' Frame1(1).Enabled = True + btnOpenPort.Caption = "Close Port" + ' CmdSend.Enabled = True + Me.Caption = "Modbus(RTU) Tool--Slave " + PortCb.Text + ":" + Settings + SaveCfg = WriteFile_INI("Configuration", "ComNumber", PortCb.Text) And WriteFile_INI("Configuration", "ComBps", RateCb.Text) And WriteFile_INI("Configuration", "ComBit", DataCb.Text) And WriteFile_INI("Configuration", "ComStopBit", StopCb.Text) And WriteFile_INI("Configuration", "ComCheck", CheckCb.Text) + + If SaveCfg = False Then GoTo ErrLog + + End If + Else + btnOpenPort.Caption = "Open Port" ''关闭串口 + + 'CmdSend.Enabled = False + If OpenFlag = True Then + OpenFlag = False + If ConnectFlag = False Then Import_Cfg.Enabled = True + MSComPort.PortOpen = False + End If +' Option2(0).Enabled = True +' Option2(1).Enabled = True +' Frame2.Enabled = False + ' AutoTimer.Enabled = False + 'OverTimer.Enabled = False + ' ComTimer.Enabled = False +' Frame1(1).Enabled = False +' Check2.Value = 0 + End If + Exit Sub +ErrLog: + + WriteLog ("Err on Saving ConfigFile") +ErrP: + MsgBox err.Description, vbCritical + vbOKOnly, "COM" +End Sub +Private Sub Initface() +Dim i As Integer + + For i = 1 To 15 + PortCb.AddItem "COM" + CStr(i) + Next i + PortCb.ListIndex = 0 + + With RateCb '波特率 + .AddItem "110" + .AddItem "300" + .AddItem "600" + .AddItem "1200" + .AddItem "2400" + .AddItem "4800" + .AddItem "9600" + .AddItem "14400" + .AddItem "19200" + .AddItem "38400" + .AddItem "57600" + .AddItem "115200" + .ListIndex = 6 + End With + + With CheckCb + .AddItem "None" '校验方式 + .AddItem "Odd" + .AddItem "Even" + .ListIndex = 0 + End With + + DataCb.AddItem "6" '数据位 + DataCb.AddItem "7" + DataCb.AddItem "8" + DataCb.ListIndex = 2 + +' stopcb.AddItem "1.5" '停止位 + StopCb.AddItem "1" + StopCb.AddItem "2" + StopCb.ListIndex = 0 + +' For i = 1 To 255 +' CbSlaveAddr.AddItem i +' Next i +' CbSlaveAddr.ListIndex = 0 +' SAddr = 1 +End Sub + +'----------【读取Excel数据】---------- +Private Sub btnReadExcel_Click() + Call xlsRead(xlsFilePath) + Call initMsFlexGrid +End Sub + +Private Sub btnTCP_Click() +If btnTCP.Caption = "Listening..." Then +Wsk_Server(0).Close +btnTCP.Caption = "Listen" +ConnectFlag = False + If OpenFlag = False Then Import_Cfg.Enabled = True + +Else + txtIPAddress(0).Text = Wsk_Server(0).LocalIP + Wsk_Server(0).LocalPort = txtIPPort(0).Text + Wsk_Server(0).RemoteHost = txtIPAddress(1).Text + Wsk_Server(0).RemotePort = txtIPPort(1).Text + '程序启动时侦听 + Wsk_Server(0).Listen + lhostName = Wsk_Server(0).LocalHostName & ":" + btnTCP.Caption = "Listening..." + ConnectFlag = True + Import_Cfg.Enabled = False + End If + +End Sub + +'----------【写入Excel数据】---------- +Private Sub btnWriteExcel_Click() + On Error Resume Next + Dim i, j, m, N + Dim xlApp, xlBook, xlSheet1 + Dim xlsFileOpen + xlsFileOpen = 0 + Set xlApp = GetObject(, "Excel.Application") '取得当前运行的Excel对象 + For i = 1 To xlApp.Workbooks.Count + Set xlBook = xlApp.Workbooks(i) '当前Excel打开的工作簿文件 + If err.number <> 0 Then Exit For + Debug.Print xlBook.fullname + If xlBook.fullname = xlsFilePath Then + xlBook.save + xlsFileOpen = 1 + Exit For + End If + Next + If xlsFileOpen = 0 Then + Set xlApp = CreateObject("Excel.Application") + Set xlBook = xlApp.Workbooks.Open(xlsFilePath) + End If + Set xlSheet1 = xlBook.Worksheets(1) + For j = 2 To colLen + For i = 2 To rowLen + xlSheet1.Cells(i, j).Value = MSFlexGrid2.TextMatrix(i - 1, j - 1) + Next + Next + xlBook.save + If xlsFileOpen = 0 Then xlApp.quit + Set xlApp = Nothing '交还控制给Excel +End Sub +'----------Form Load and Initiation---------- +Private Sub Form_Load() + '------------------------------------------------- + + txtAutoData.Visible = False + Initface + xlsFilePath = App.Path & "\ModbusData.xls" + Call xlsRead(xlsFilePath) + Call initMsFlexGrid + '------------------------------------------------- + + Timer1.Enabled = False + Call ImportCfgFile + + +End Sub + +'----------程序初始化，将Excel表格数据读入---------- +Private Sub xlsRead(ByVal xlsFilePath As String) + On Error Resume Next + Dim i, j + Dim xlApp, xlBook, xlSheet1 + Dim xlsFileOpen + + xlsFileOpen = 0 + Set xlApp = GetObject(, "Excel.Application") '取得当前运行的Excel对象 + If err.number = 0 Then + For i = 1 To xlApp.Workbooks.Count + Set xlBook = xlApp.Workbooks(i) '当前Excel打开的工作簿文件 + If err.number <> 0 Then Exit For + Debug.Print xlBook.fullname + If xlBook.fullname = xlsFilePath Then + xlBook.save + xlsFileOpen = 1 + Exit For + End If + Next + End If + If xlsFileOpen = 0 Then + Set xlApp = CreateObject("Excel.Application") + Set xlBook = xlApp.Workbooks.Open(xlsFilePath) + End If + Set xlSheet1 = xlBook.Worksheets(1) + rowLen = xlSheet1.usedrange.Rows.Count + colLen = xlSheet1.usedrange.Columns.Count + ReDim InputS(rowLen) + ReDim CoilS(rowLen) + ReDim InputR(rowLen) + ReDim HoldR(rowLen) + For i = 1 To xlSheet1.usedrange.Rows.Count + InputS(i - 1) = xlSheet1.Cells(i, 2).Value + CoilS(i - 1) = xlSheet1.Cells(i, 3).Value + InputR(i - 1) = xlSheet1.Cells(i, 4).Value + HoldR(i - 1) = xlSheet1.Cells(i, 5).Value + Next + xlBook.save + If xlsFileOpen = 0 Then xlApp.quit + Set xlApp = Nothing '交还控制给Excel +End Sub + +'----------程序初始化，将Excel表格数据写入控件---------- +Private Sub initMsFlexGrid() + Dim i, j + '-------------------初始化全自动运行表头---------------------------- + MSFlexGrid2.Rows = rowLen '设置MSFlexGrid 表格的总行数 + MSFlexGrid2.Cols = colLen '设置MSFlexGrid 表格的总列数 + '设置MSFlexGrid 表格的列宽 + For i = 0 To rowLen - 1 + MSFlexGrid2.RowHeight(i) = 300 + Next + MSFlexGrid2.ColWidth(0) = 850 + For i = 1 To colLen - 1 + MSFlexGrid2.ColWidth(i) = 1500 + Next + '设置MSFlexGrid 表格的固定行数 + MSFlexGrid2.FixedRows = 1 + '设置MSFlexGrid 表格的固定列数 + MSFlexGrid2.FixedCols = 1 + '设置MSFlexGrid 表格的表头信息 + MSFlexGrid2.TextMatrix(0, 0) = "No." + MSFlexGrid2.TextMatrix(0, 1) = InputS(0) + MSFlexGrid2.TextMatrix(0, 2) = CoilS(0) + MSFlexGrid2.TextMatrix(0, 3) = InputR(0) + MSFlexGrid2.TextMatrix(0, 4) = HoldR(0) + + '为MSFlexGrid 表格设置序号,并读入数据 + For i = 1 To rowLen - 1 + MSFlexGrid2.TextMatrix(i, 0) = i + MSFlexGrid2.TextMatrix(i, 1) = InputS(i) + MSFlexGrid2.TextMatrix(i, 2) = CoilS(i) + MSFlexGrid2.TextMatrix(i, 3) = InputR(i) + + MSFlexGrid2.TextMatrix(i, 4) = HoldR(i) + Next i + '------------------------------------------------------------------- +End Sub + + + + + +Private Sub Timer1_Timer() +For i = 1 To 800 +MSFlexGrid2.TextMatrix(i, 4) = Rnd * 10000 +Next +End Sub + + + + + + + +'----------TCP通讯-客户端断开连接时，关闭连接---------- +Private Sub Wsk_Server_Close(Index As Integer) + On Error Resume Next + Dim strWelc + strWelc = "欢迎您的再次光临，再见！" + Wsk_Server(ClientNum).SendData strWelc + Wsk_Server(Index).Close +End Sub + +'============================================================================= +'e.State属性 +' 返回WinSock控件当前的状态 +' +' 常数 值 描述 +' sckClosed 0 缺省值,关闭。 +' SckOpen 1 打开。 +' SckListening 2 侦听 +' sckConnectionPending 3 连接挂起 +' sckResolvingHost 4 识别主机。 +' sckHostResolved 5 已识别主机 +' sckConnecting 6 正在连接。 +' sckConnected 7 已连接。 +' sckClosing 8 同级人员正在关闭连接。 +' sckError 9 错误 +'============================================================================= +'----------TCP通讯-接收客户端连接请求---------- +Private Sub Wsk_Server_ConnectionRequest(Index As Integer, ByVal requestID As Long) + On Error Resume Next + Dim i, j, strWelc + strWelc = "欢迎您的光临！！" + j = 0 + For i = 1 To ClientNum + If Wsk_Server(i).State <> 7 Then + Wsk_Server(i).Close + j = i + End If + Next + If j > 0 Then + Wsk_Server(j).Accept requestID '接受客户端的请求 + Wsk_Server(j).SendData strWelc + Else + ClientNum = ClientNum + 1 + Load Wsk_Server(ClientNum) '载入一个新的socket控件 + Wsk_Server(ClientNum).Accept requestID '接受客户端的请求 + Wsk_Server(ClientNum).SendData lhostName & strWelc + End If +End Sub + +'----------TCP通讯-接收客户端数据---------- +Private Sub Wsk_Server_DataArrival(Index As Integer, ByVal bytesTotal As Long) + Dim i, j As Integer + Dim s As String + Dim s1 As String + Dim IO As Byte + Dim strdata() As Byte + i = Wsk_Server(Index).BytesReceived + ReDim strdata(i) + Wsk_Server(Index).GetData strdata, vbByte, i + For j = 0 To i - 1 + s = s + " " + Right("000" & strdata(j), 3) + s1 = s1 & " " & strdata(j) + Next + Debug.Print "server index-" & Index & " : " & s + Call Ack_Server(strdata(), Index) +End Sub +'----------Modbus通讯-接收客户端数据---------- +Private Sub MSComPort_OnComm() +Dim bytInput() As Byte + Dim intInputLen As Integer + Dim N As Integer + Dim teststring As String + Dim s1 As String + Dim AscFlag As Boolean + Dim mo As Boolean + Dim t1, t2, t3, t4, t5 As String + AscFlag = True + mo = True + + Select Case MSComPort.CommEvent + Case comEvReceive + If mo = True Then + MSComPort.InputMode = 1 '0：文本方式，1：二进制方式 + Else + MSComPort.InputMode = 0 '0：文本方式，1：二进制方式 + End If + + intInputLen = MSComPort.InBufferCount + bytInput = MSComPort.Input + + If AscFlag = True Then + For N = 0 To intInputLen - 1 + s1 = s1 & " " & IIf(Len(Hex$(bytInput(N))) > 1, Hex$(bytInput(N)), "0" & Hex$(bytInput(N))) + Next N + t1 = Crc_16(MidB(bytInput, 1, 6)) + t4 = t1 \ 256 + t5 = t1 Mod 256 + t2 = bytInput(6) + t3 = bytInput(7) + Else + teststring = bytInput + s1 = s1 + teststring + + End If + Debug.Print "ComData" & " : " & s1 + + Call Ack_Server_RTU(bytInput()) + End Select + + +End Sub + +'----------TCP通讯-客户端出现通讯故障---------- +Private Sub Wsk_Server_Error(Index As Integer, 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) + On Error Resume Next + Wsk_Server(Index).Close + +End Sub + +'---------------- acknowledge to server(TCP) ------------------------------ +Private Sub Ack_Server(strdata() As Byte, Index As Integer) + '----------------response to server---------- + On Error GoTo ErrProc + Dim AckStr() As Byte + Dim i, j, stAddr, ackLen, a1, a2, a3, a4 As Integer + Dim TmpStr As String + Dim TmpStr1 As String + Dim a As Single + Dim FunctionCode As Integer + Dim AckLength As Integer + FunctionCode = strdata(7) + AckLength = strdata(11) + Select Case FunctionCode + Case 1, 2: ackLen = 8 + AckLength \ 8 + 1 '读线圈 + Case 3, 4: ackLen = 9 + AckLength * 2 '读寄存器 + Case 5, 6, 15, 16: ackLen = 12 '写寄存器 + + End Select + + ReDim AckStr(ackLen) As Byte + AckStr(0) = strdata(0) '交换识别号高字节，通常为 0 + AckStr(1) = strdata(1) '交换识别号低字节，通常为 0 + '------------------------------------- + AckStr(2) = 0 '协议识别号高字节，为 0 + AckStr(3) = 0 '协议识别号低字节，为 0 + AckStr(4) = 0 '字节长度高字节 + '------------------------------------- + Dim strSend As String + + If FunctionCode = 1 Or FunctionCode = 2 Then '=========== 线圈 + AckStr(5) = strdata(11) \ 8 + 1 + 3 + AckStr(6) = strdata(6) + AckStr(7) = strdata(7) + AckStr(8) = strdata(11) \ 8 + 1 + Dim temp As Byte, N As Integer + For i = 9 To 9 + strdata(11) \ 8 + temp = 0: N = 0 + For j = strdata(8) * 256 + strdata(9) + (i - 9) * 8 + 1 To strdata(8) * 256 + strdata(9) + (i - 9) * 8 + 8 + If j > strdata(8) * 256 + strdata(9) + strdata(10) * 256 + strdata(11) Then Exit For + Select Case strdata(7) + Case 1: temp = temp + MSFlexGrid2.TextMatrix(j, 1) * 2 ^ N + Case 2: temp = temp + MSFlexGrid2.TextMatrix(j, 2) * 2 ^ N + End Select + N = N + 1 + Next + AckStr(i) = temp + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + ElseIf FunctionCode = 3 Or FunctionCode = 4 Then '=========== 寄存器 + AckStr(5) = strdata(11) * 2 + 3 '以下字节长度低字节 + AckStr(6) = strdata(6) '单元识别号，缺省为 255 + AckStr(7) = strdata(7) '读多个寄存器命令代码 + AckStr(8) = strdata(11) * 2 '读数据的起始地址高字节 + stAddr = strdata(9) + strdata(8) * 16 + j = 1 + For i = 9 To ackLen - 1 Step 4 + Select Case strdata(7) + Case 3: '返回数据 +' AckStr(i) = Right("00" & (MSFlexGrid2.TextMatrix(stAddr + j, 4) \ 256), 3) '数据高字节 +' AckStr(i + 1) = Right("000" & MSFlexGrid2.TextMatrix(stAddr + j, 4) Mod 256, 3) '数据低字节 + 'TmpStr = OTC2Single(MSFlexGrid2.TextMatrix(stAddr + j, 4)) + a = Val(MSFlexGrid2.TextMatrix(stAddr + j, 4)) + CopyMemory AckStr(i), a, 4 + a1 = AckStr(i) + a2 = AckStr(i + 1) + a3 = AckStr(i + 2) + a4 = AckStr(i + 3) + AckStr(i) = a2 + AckStr(i + 1) = a1 + AckStr(i + 2) = a4 + AckStr(i + 3) = a3 + ' AckStr(i) = OTC2Single() '数据高字节 + ' AckStr(i + 1) = Right("000" & TmpStr, 2) '数据低字节 + TmpStr = Hex(AckStr(9)) & " " & Hex(AckStr(10)) & " " & Hex(AckStr(11)) & " " & Hex(AckStr(12)) + TmpStr1 = OTC2Single(MSFlexGrid2.TextMatrix(stAddr + j, 4)) + Debug.Print TmpStr + Debug.Print TmpStr1 + Case 4: + AckStr(i) = Right("00" & (MSFlexGrid2.TextMatrix(stAddr + j, 3) \ 256), 3) '数据高字节 + AckStr(i + 1) = Right("000" & MSFlexGrid2.TextMatrix(stAddr + j, 3) Mod 256, 3) '数据低字节 + End Select + j = j + 1 + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + ElseIf FunctionCode = 5 Or FunctionCode = 6 Then '=========== + For i = 5 To 11 + AckStr(i) = strdata(i) + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + ElseIf FunctionCode = 15 Or FunctionCode = 16 Then '=========== + AckStr(5) = 6 + For i = 6 To 11 + AckStr(i) = strdata(i) + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + + End If + Debug.Print "sending data:" & vbTab & strSend + + + + Wsk_Server(Index).SendData AckStr + + + + '----------- update the form data ------------------ + If FunctionCode = 5 Then + If strdata(10) = 255 Then strdata(10) = 1 + MSFlexGrid2.TextMatrix(strdata(8) * 256 + strdata(9) + 1, 1) = strdata(10) + ElseIf FunctionCode = 6 Then + MSFlexGrid2.TextMatrix(strdata(8) * 256 + strdata(9) + 1, 4) = strdata(10) * 256 + strdata(11) + ElseIf FunctionCode = 15 Then + Dim Temp1 As String + N = N + 1 + For i = 13 To 13 + strdata(12) - 1 + Temp1 = Byte_to_BIN(strdata(i)) & Temp1 + Next + j = 1: Temp1 = StrReverse(Temp1) + Debug.Print Temp1 + For i = strdata(8) * 256 + strdata(9) To strdata(8) * 256 + strdata(9) + strdata(10) * 256 + strdata(11) - 1 + MSFlexGrid2.TextMatrix(i + 1, 1) = Left$(Temp1, 1) + Temp1 = Mid$(Temp1, 2) + Next + ElseIf FunctionCode = 16 Then + j = 1 + For i = 0 To strdata(12) - 1 Step 2 + MSFlexGrid2.TextMatrix(strdata(8) * 256 + strdata(9) + j, 4) = strdata(13 + i) * 256 + strdata(14 + i) + j = j + 1 + Next + End If + Exit Sub +ErrProc: + Debug.Print "传输数据失败:" & vbTab & err.Description +End Sub +'---------------- acknowledge to server(RTU) ------------------------------ +Private Sub Ack_Server_RTU(strdata() As Byte) + '----------------response to server---------- + On Error GoTo ErrProc + Dim AckStr() As Byte + Dim i, j, stAddr, ackLen, a1, a2, a3, a4 As Integer + Dim TmpStr, CRCStr As String + Dim TmpStr1 As String + Dim a As Single + Dim FunctionCode As Integer + Dim AckLength As Integer + FunctionCode = strdata(1) + AckLength = strdata(5) + + Select Case FunctionCode + Case 1, 2: ackLen = 4 + AckLength \ 8 + 1 '读线圈 + Case 3, 4: ackLen = 5 + AckLength * 2 '读寄存器 + Case 5, 6, 15, 16: ackLen = 8 '写寄存器 + + End Select + + ReDim AckStr(ackLen) As Byte + AckStr(0) = strdata(0) '交换识别号高字节，通常为 0 + AckStr(1) = strdata(1) '交换识别号低字节，通常为 0 + '------------------------------------- + + Dim strSend As String + + If FunctionCode = 1 Or FunctionCode = 2 Then '=========== 线圈 + AckStr(2) = strdata(6) \ 8 + 1 + Dim temp As Byte, N As Integer + For i = 3 To 3 + strdata(5) \ 8 + temp = 0: N = 0 + For j = strdata(2) * 256 + strdata(3) + (i - 3) * 8 + 1 To strdata(2) * 256 + strdata(3) + (i - 3) * 8 + 8 + If j > strdata(2) * 256 + strdata(3) + strdata(4) * 256 + strdata(5) Then Exit For + Select Case FunctionCode + Case 1: temp = temp + MSFlexGrid2.TextMatrix(j, 1) * 2 ^ N + Case 2: temp = temp + MSFlexGrid2.TextMatrix(j, 2) * 2 ^ N + End Select + N = N + 1 + Next + AckStr(i) = temp + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + ElseIf FunctionCode = 3 Or FunctionCode = 4 Then '=========== 寄存器 + AckStr(2) = strdata(5) * 2 '读数据的起始地址高字节 + stAddr = strdata(3) + strdata(2) * 16 + j = 1 + For i = 3 To ackLen - 5 Step 4 + Select Case FunctionCode + Case 3: '返回数据 +' AckStr(i) = Right("00" & (MSFlexGrid2.TextMatrix(stAddr + j, 4) \ 256), 3) '数据高字节 +' AckStr(i + 1) = Right("000" & MSFlexGrid2.TextMatrix(stAddr + j, 4) Mod 256, 3) '数据低字节 + 'TmpStr = OTC2Single(MSFlexGrid2.TextMatrix(stAddr + j, 4)) + a = Val(MSFlexGrid2.TextMatrix(stAddr + j, 4)) + CopyMemory AckStr(i), a, 4 + a1 = AckStr(i) + a2 = AckStr(i + 1) + a3 = AckStr(i + 2) + a4 = AckStr(i + 3) + AckStr(i) = a2 + AckStr(i + 1) = a1 + AckStr(i + 2) = a4 + AckStr(i + 3) = a3 + ' AckStr(i) = OTC2Single() '数据高字节 + ' AckStr(i + 1) = Right("000" & TmpStr, 2) '数据低字节 +' TmpStr = Hex(AckStr(3)) & " " & Hex(AckStr(4)) & " " & Hex(AckStr(5)) & " " & Hex(AckStr(6)) +' TmpStr1 = OTC2Single(MSFlexGrid2.TextMatrix(stAddr + j, 4)) +' Debug.Print TmpStr +' Debug.Print TmpStr1 + Case 4: + AckStr(i) = Right("00" & (MSFlexGrid2.TextMatrix(stAddr + j, 3) \ 256), 3) '数据高字节 + AckStr(i + 1) = Right("000" & MSFlexGrid2.TextMatrix(stAddr + j, 3) Mod 256, 3) '数据低字节 + End Select + j = j + 1 + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + ElseIf FunctionCode = 5 Or FunctionCode = 6 Then '=========== + For i = 2 To 6 + AckStr(i) = strdata(i) + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + ElseIf FunctionCode = 15 Or FunctionCode = 16 Then '=========== + For i = 2 To 6 + AckStr(i) = strdata(i) + Next + For i = 0 To ackLen - 1 + strSend = strSend & " " & Right("000" & AckStr(i), 3) + Next + + End If + + CRCStr = Crc_16(MidB(AckStr, 1, ackLen - 2)) + + AckStr(ackLen - 2) = CRCStr Mod 256 + AckStr(ackLen - 1) = CRCStr \ 256 + Debug.Print "ComPort Sending data:" & vbTab & strSend + MSComPort.Output = AckStr + + + + + + '----------- update the form data ------------------ + If FunctionCode = 5 Then + If FunctionCode = 255 Then strdata(10) = 1 + MSFlexGrid2.TextMatrix(strdata(8) * 256 + strdata(9) + 1, 1) = strdata(10) + ElseIf FunctionCode = 6 Then + MSFlexGrid2.TextMatrix(strdata(8) * 256 + strdata(9) + 1, 4) = strdata(10) * 256 + strdata(11) + ElseIf FunctionCode = 15 Then + Dim Temp1 As String + N = N + 1 + For i = 13 To 13 + strdata(12) - 1 + Temp1 = Byte_to_BIN(strdata(i)) & Temp1 + Next + j = 1: Temp1 = StrReverse(Temp1) + Debug.Print Temp1 + For i = strdata(8) * 256 + strdata(9) To strdata(8) * 256 + strdata(9) + strdata(10) * 256 + strdata(11) - 1 + MSFlexGrid2.TextMatrix(i + 1, 1) = Left$(Temp1, 1) + Temp1 = Mid$(Temp1, 2) + Next + ElseIf FunctionCode = 16 Then + j = 1 + For i = 0 To strdata(12) - 1 Step 2 + MSFlexGrid2.TextMatrix(strdata(8) * 256 + strdata(9) + j, 4) = strdata(13 + i) * 256 + strdata(14 + i) + j = j + 1 + Next + End If + Exit Sub +ErrProc: + Debug.Print "传输数据失败:" & vbTab & err.Description +End Sub + +'----------【单击单元格】---------- +Private Sub MSFlexGrid2_Click() '单击单元格 + '指定text1 控件在MSFlexGrid1 表格中的大小及位置 + txtAutoData.Width = MSFlexGrid2.CellWidth + txtAutoData.Height = MSFlexGrid2.CellHeight + txtAutoData.Left = MSFlexGrid2.CellLeft + MSFlexGrid2.Left + txtAutoData.Top = MSFlexGrid2.CellTop + MSFlexGrid2.Top + '赋值给MSFlexGrid2.Text + txtAutoData.Text = MSFlexGrid2.Text + txtAutoData.SelStart = 0 + txtAutoData.SelLength = Len(txtAutoData.Text) + 'text1 可见 + txtAutoData.Visible = True + 'text1 获得焦点 + txtAutoData.SetFocus +End Sub + +'----------【单元格回车】---------- +Private Sub MSFlexGrid2_KeyPress(KeyAscii As Integer) + MSFlexGrid2_Click +End Sub + +'---------- keypress on textbox ----------- +Private Sub txtAutoData_KeyPress(KeyAscii As Integer) + On Error Resume Next + If KeyAscii = vbKeyEscape Then '当按下ESC 键时 + txtAutoData.Visible = False 'text1 不可见 + MSFlexGrid2.SetFocus 'MSFlexGrid1 获得焦点 + Exit Sub + End If + If KeyAscii = vbKeyReturn Then '当按下回车键时 + '赋值给txtAutodata.text + MSFlexGrid2.Text = txtAutoData.Text + If MSFlexGrid2.Row < MSFlexGrid2.Rows Then + MSFlexGrid2.Row = MSFlexGrid2.Row + 1 + Else + MSFlexGrid2.Col = MSFlexGrid2.Col + 1 + MSFlexGrid2.Row = 1 + End If + '指定text1 控件在MSFlexGrid2 表格中的大小及位置 + txtAutoData.Width = MSFlexGrid2.CellWidth + txtAutoData.Height = MSFlexGrid2.CellHeight + txtAutoData.Left = MSFlexGrid2.CellLeft + MSFlexGrid2.Left + txtAutoData.Top = MSFlexGrid2.CellTop + MSFlexGrid2.Top + '赋值给MSFlexGrid2.Text + txtAutoData.Text = MSFlexGrid2.Text + txtAutoData.SelStart = 0 + txtAutoData.SelLength = Len(txtAutoData.Text) + txtAutoData.SetFocus 'text1 获得焦点 + End If +End Sub + +'---------- double click on the textbox then hide it ---------- +Private Sub txtAutoData_DblClick() + txtAutoData.Visible = False +End Sub + +' 用途：将十进制转化为二进制 +' 输入：Byte1(十进制数) +' 输入数据类型：byte +' 输出：Byte_to_BIN(二进制数) +' 输出数据类型：String +' 输入的最大数为255,输出最大数为1111 1111 (8个1) +Private Function Byte_to_BIN(Byte1 As Byte) As String + Byte_to_BIN = "" + Dim i As Integer + For i = 0 To 7 + Byte_to_BIN = Byte1 Mod 2 & Byte_to_BIN + Byte1 = Byte1 \ 2 + Next +End Function +Private Function OTC2Single(text1 As Single) As Variant + +Dim hexData As String + Dim i As Integer + Dim a As Single + Dim Buffer(3) As Byte + a = Val(text1) + CopyMemory Buffer(0), a, 4 + For i = 0 To 3 + If Len(Hex(Buffer(i))) = 1 Then + hexData = "0" & Hex(Buffer(i)) + hexData + Else + hexData = Hex(Buffer(i)) + hexData + End If + Next + OTC2Single = hexData +End Function diff --git a/VB_Modbus.frx b/VB_Modbus.frx new file mode 100644 index 0000000..a22f83c Binary files /dev/null and b/VB_Modbus.frx differ diff --git a/VB_Modbus.log b/VB_Modbus.log new file mode 100644 index 0000000..cf59049 --- /dev/null +++ b/VB_Modbus.log @@ -0,0 +1,3 @@ +行 34: 控件 MSComPort 的类 MSCommLib.MSComm 不是一个已加载的控件类。 +行 277: 控件 MSFlexGrid2 的类 MSFlexGridLib.MSFlexGrid 不是一个已加载的控件类。 +行 436: 控件 Wsk_Server 的类 MSWinsockLib.Winsock 不是一个已加载的控件类。 diff --git a/VB_TCP_Modbus.vbp b/VB_TCP_Modbus.vbp new file mode 100644 index 0000000..3d087fc --- /dev/null +++ b/VB_TCP_Modbus.vbp @@ -0,0 +1,48 @@ +Type=Exe +Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation +Reference=*\G{28E68F91-8D75-11D1-8DC3-3C302A000000}#1.0#0#C:\WINDOWS\system32\OPCDAAuto.dll#OPC Automation 2.0 +Object={248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0; Mswinsck.OCX +Object={5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0; MSFLXGRD.OCX +Object={831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0; MSCOMCTL.OCX +Object={648A5603-2C6E-101B-82B6-000000000014}#1.1#0; MSCOMM32.OCX +Form=VB_Modbus.frm +Module=PublicMod; PublicMod.bas +Class=CIniFile; CIniFile.cls +Class=CSVParse; CSVParse.cls +Module=Method; Method.bas +Module=Variable; Variable.bas +Class=OPCClass; OPCClass.cls +IconForm="fmMain" +Startup="fmMain" +HelpFile="" +Title="Modbus Slave" +ExeName32="VB_TCP_Modbus.exe" +Command32="" +Name="Modbus" +HelpContextID="0" +CompatibleMode="0" +MajorVer=1 +MinorVer=0 +RevisionVer=0 +AutoIncrementVer=0 +ServerSupportFiles=0 +VersionCompanyName="Alstom China Ltd." +CompilationType=0 +OptimizationType=0 +FavorPentiumPro(tm)=0 +CodeViewDebugInfo=0 +NoAliasing=0 +BoundsCheck=0 +OverflowCheck=0 +FlPointCheck=0 +FDIVCheck=0 +UnroundedFP=0 +StartMode=0 +Unattended=0 +Retained=0 +ThreadPerObject=0 +MaxNumberOfThreads=1 +DebugStartupOption=0 + +[MS Transaction Server] +AutoRefresh=1 diff --git a/VB_TCP_Modbus.vbw b/VB_TCP_Modbus.vbw new file mode 100644 index 0000000..b55748e --- /dev/null +++ b/VB_TCP_Modbus.vbw @@ -0,0 +1,7 @@ +fmMain = 176, 232, 1139, 754, Z, 154, 203, 1117, 725, C +PublicMod = 44, 58, 1007, 580, +CIniFile = 198, 261, 1161, 783, +CSVParse = 110, 145, 1073, 667, +Method = 0, 0, 963, 522, +Variable = 154, 203, 1117, 725, +OPCClass = 0, 0, 963, 522, diff --git a/Variable.bas b/Variable.bas new file mode 100644 index 0000000..bb4af86 --- /dev/null +++ b/Variable.bas @@ -0,0 +1,14 @@ +Attribute VB_Name = "Variable" +Type TagData + Tag As String '结构体中标签名 + TagName As String + HH As Double '结构体中量程上限 + LL As Double '结构体中量程下限 + N As Integer '结构体中有效采集累加的计数值 + Value As Double '对应的采集值 + +End Type + + +Public Data() As TagData +Public TagSum As Integer diff --git a/readme.txt b/readme.txt new file mode 100644 index 0000000..a4f6fc8 --- /dev/null +++ b/readme.txt @@ -0,0 +1,7 @@ +1.实现配置文件导入及自动存储，异常记录 +2.列表数据来源于excel文件 +3.实现ModbusTCP和RTU通讯 +4.加入CSV数据导入功能 +5.加入OPC Class +6.修改界面 +7.OPC Subscribe功能 \ No newline at end of file