Warning: Can't use blame annotator:
svn blame failed on trunk/desktop/ICSSerialPort.rbbas: ("Can't find a temporary directory: Internal error", 20014)

source: trunk/desktop/ICSSerialPort.rbbas @ 11

Revision 11, 15.0 KB checked in by pinwc4, 15 years ago (diff)

Added more database logic and a screen for creating a new profile

RevLine 
1#tag Class
2Protected Class ICSSerialPort
3Inherits serial
4        #tag Method, Flags = &h0
5                Sub resetCar()
6                  //This sends the command to reset the car back to a default configuration
7                  //Defaults are different for each car type
8                  setDefaultValues
9                 
10                  //Send the default values to the car
11                  writeCar
12                End Sub
13        #tag EndMethod
14
15        #tag Method, Flags = &h0
16                Sub setDefaultValues()
17                  //Set the defaults for the bytes sent to a car
18                 
19                  select case carType
20                   
21                  case "MR-03"
22                    byte01 = chrb(&hD5)
23                    byte02 = chrb(&h5A)
24                    byte03 = chrb(&h64)
25                    byte04 = chrb(&hFF)
26                    byte05 = chrb(&h02)
27                    byte06 = chrb(&h02)
28                    byte07 = chrb(&h01)
29                    byte08 = chrb(&hFF)
30                    byte09 = chrb(&hBC)
31                    byte10 = chrb(&h44)
32                    byte11 = chrb(&h88)
33                    byte12 = chrb(&h78)
34                    byte13 = chrb(&hFF)
35                    byte14 = chrb(&h2C)
36                    byte15 = chrb(&h05)
37                    byte16 = chrb(&h5A)
38                    byte17 = chrb(&h3C)
39                    byte18 = chrb(&h87)
40                   
41                  case "dNaNo"
42                    byte01 = chrb(&hD5)
43                    byte02 = chrb(&h5A)
44                    byte03 = chrb(&hFF)
45                    byte04 = chrb(&hFF)
46                    byte05 = chrb(&h0A)
47                    byte06 = chrb(&h03)
48                    byte07 = chrb(&h01)
49                    byte08 = chrb(&h40)
50                    byte09 = chrb(&hBC)
51                    byte10 = chrb(&h44)
52                    byte11 = chrb(&h88)
53                    byte12 = chrb(&h78)
54                    byte13 = chrb(&h03)
55                    byte14 = chrb(&hFF)
56                    byte15 = chrb(&hFF)
57                    byte16 = chrb(&h80)
58                    byte17 = chrb(&h80)
59                    byte18 = chrb(&hA7)
60                   
61                  case "ASF"
62                    byte01 = chrb(&hD5)
63                    byte02 = chrb(&h5A)
64                    byte03 = chrb(&hFF)
65                    byte04 = chrb(&hFF)
66                    byte05 = chrb(&h0A)
67                    byte06 = chrb(&h03)
68                    byte07 = chrb(&h01)
69                    byte08 = chrb(&h78)
70                    byte09 = chrb(&hBC)
71                    byte10 = chrb(&h44)
72                    byte11 = chrb(&h88)
73                    byte12 = chrb(&h78)
74                    byte13 = chrb(&h03)
75                    byte14 = chrb(&hFF)
76                    byte15 = chrb(&hFF)
77                    byte16 = chrb(&hFF)
78                    byte17 = chrb(&hFF)
79                    byte18 = chrb(&hDD)
80                   
81                  else
82                    //default thing to do
83                    MsgBox "Error invalid car type"
84                    return
85                  end select
86                 
87                  //trigger the event definition so main program knows the values changed
88                  valuesChanged()
89                End Sub
90        #tag EndMethod
91
92        #tag Method, Flags = &h0
93                Sub setCarType(value as string)
94                  //When setting car type we must reconfigure the serial port
95                  //Some car types have a different baud rate
96                 
97                  select case value
98                   
99                  case "MR-03"
100                    carType = value
101                    byte15 = chrb(&h05)
102                    byte16 = chrb(&h5A)
103                    byte17 = chrb(&h3C)
104                  case "dNaNo"
105                    carType = value
106                    byte15 = chrb(&hFF)
107                    byte16 = chrb(&h80)
108                    byte17 = chrb(&h80)
109                  case "ASF"
110                    carType = value
111                    byte15 = chrb(&hFF)
112                    byte16 = chrb(&hFF)
113                    byte17 = chrb(&hFF)
114                   
115                  else
116                    MsgBox "Error setting Car Type"
117                  end select
118                 
119                  valuesChanged()
120                End Sub
121        #tag EndMethod
122
123        #tag Method, Flags = &h0
124                Sub writeCar()
125                  //Send set bytes to the car
126                  mode = "write"
127                 
128                  dim sendstring as string
129                 
130                  calculateChecksum()
131                 
132                  sendstring = byte01 + byte02 + byte03 + byte04 + byte05 + byte06 + byte07 + byte08 + byte09 + byte10 + byte11 + byte12 + byte13 + byte14 + byte15 + byte16 + byte17 + byte18
133                 
134                  me.Write(sendstring)
135                End Sub
136        #tag EndMethod
137
138        #tag Method, Flags = &h0
139                Sub calculateChecksum()
140                  //Use this to calculate byte 18, the checksum
141                  //The checksum is just adding bytes 2-17 together but rounded at each byte
142                 
143                  dim i as integer
144                 
145                  i = (asc(byte02) + asc(byte03)) mod &h100
146                  i = (i + asc(byte04)) mod &h100
147                  i = (i + asc(byte05)) mod &h100
148                  i = (i + asc(byte06)) mod &h100
149                  i = (i + asc(byte07)) mod &h100
150                  i = (i + asc(byte08)) mod &h100
151                  i = (i + asc(byte09)) mod &h100
152                  i = (i + asc(byte10)) mod &h100
153                  i = (i + asc(byte11)) mod &h100
154                  i = (i + asc(byte12)) mod &h100
155                  i = (i + asc(byte13)) mod &h100
156                  i = (i + asc(byte14)) mod &h100
157                  i = (i + asc(byte15)) mod &h100
158                  i = (i + asc(byte16)) mod &h100
159                  i = (i + asc(byte17)) mod &h100
160                 
161                  byte18 = chrb(i)
162                 
163                  valuesChanged()
164                End Sub
165        #tag EndMethod
166
167        #tag Method, Flags = &h0
168                Sub readCar()
169                  //Read values from the currently attached car
170                 
171                  mode = "read"
172                End Sub
173        #tag EndMethod
174
175        #tag Method, Flags = &h0
176                Sub Constructor()
177                  //Make sure we have a database and if not create it
178                  dim exists as boolean
179                 
180                  exists = prepareDB()
181                  if exists = false then
182                    //No database available, create one
183                    createDB()
184                  else
185                    //Database exists, connect to it
186                    if fsicsdb.Connect = false then
187                      MsgBox "Database connection failed"
188                    end if
189                  end if
190                 
191                  //Set default byte values
192                  byte01 = chrb(&hD5)
193                  byte02 = chrb(&h5A)
194                  byte03 = chrb(&h64)
195                  byte04 = chrb(&hFF)
196                  byte05 = chrb(&h02)
197                  byte06 = chrb(&h02)
198                  byte07 = chrb(&h01)
199                  byte08 = chrb(&hFF)
200                  byte09 = chrb(&hBC)
201                  byte10 = chrb(&h44)
202                  byte11 = chrb(&h88)
203                  byte12 = chrb(&h78)
204                  byte13 = chrb(&hFF)
205                  byte14 = chrb(&h2C)
206                  byte15 = chrb(&h05)
207                  byte16 = chrb(&h5A)
208                  byte17 = chrb(&h3C)
209                  byte18 = chrb(&h87)
210                 
211                  carType = "MR-03"
212                End Sub
213        #tag EndMethod
214
215        #tag Method, Flags = &h21
216                Private Function prepareDB() As Boolean
217                  //Open the database file
218                  fsicsdb = new REALSQLDatabase
219                  dim f as FolderItem = GetFolderItem("fsicsdb")
220                  fsicsdb.DatabaseFile = f
221                 
222                  return f.Exists
223                End Function
224        #tag EndMethod
225
226        #tag Method, Flags = &h21
227                Private Sub createDB()
228                  //Create a new database
229                 
230                 
231                  //make sure we can create the file
232                  if fsicsdb.CreateDatabaseFile() then
233                    if fsicsdb.Connect() then
234                      dim query as string
235                      query = "CREATE TABLE carprofiles (id INTEGER PRIMARY KEY, name VARCHAR, cartype VARCHAR, byte01 INTEGER, byte02 INTEGER, byte03 INTEGER, byte04 INTEGER, byte05 INTEGER, byte06 INTEGER"+_
236                      ", byte07 INTEGER, byte08 INTEGER, byte09 INTEGER, byte10 INTEGER, byte11 INTEGER, byte12 INTEGER, byte13 INTEGER, byte14 INTEGER, byte15 INTEGER, byte16 INTEGER, byte17 INTEGER"+_
237                      ", byte18 INTEGER, UNIQUE(name))"
238                      fsicsdb.SQLExecute(query)
239                      if fsicsdb.Error then
240                        MsgBox "Database Error (carprofiles):" + fsicsdb.ErrorMessage
241                        fsicsdb.Rollback
242                       
243                      else
244                        fsicsdb.Commit
245                      end if
246                     
247                     
248                    else
249                      MsgBox "Failed to connect to new database file"
250                    end if
251                  else
252                    //Failed to create database file
253                    MsgBox "Failed to create database file"
254                  end if
255                End Sub
256        #tag EndMethod
257
258        #tag Method, Flags = &h0
259                Function createProfile(theName as String) As Boolean
260                  dim success as boolean
261                  success = false
262                 
263                  //Make sure we got a name
264                  if theName = "" then
265                    return success
266                  else
267                    //Build a new database record
268                    dim rec as DatabaseRecord
269                    rec = New DatabaseRecord
270                   
271                    rec.Column("name") = theName
272                    rec.Column("cartype") = carType
273                    rec.IntegerColumn("byte01") = asc(byte01)
274                    rec.IntegerColumn("byte02") = asc(byte02)
275                    rec.IntegerColumn("byte03") = asc(byte03)
276                    rec.IntegerColumn("byte04") = asc(byte04)
277                    rec.IntegerColumn("byte05") = asc(byte05)
278                    rec.IntegerColumn("byte06") = asc(byte06)
279                    rec.IntegerColumn("byte07") = asc(byte07)
280                    rec.IntegerColumn("byte08") = asc(byte08)
281                    rec.IntegerColumn("byte09") = asc(byte09)
282                    rec.IntegerColumn("byte10") = asc(byte10)
283                    rec.IntegerColumn("byte11") = asc(byte11)
284                    rec.IntegerColumn("byte12") = asc(byte12)
285                    rec.IntegerColumn("byte13") = asc(byte13)
286                    rec.IntegerColumn("byte14") = asc(byte14)
287                    rec.IntegerColumn("byte15") = asc(byte15)
288                    rec.IntegerColumn("byte16") = asc(byte16)
289                    rec.IntegerColumn("byte17") = asc(byte17)
290                    rec.IntegerColumn("byte18") = asc(byte18)
291                   
292                    fsicsdb.InsertRecord("carprofiles", rec)
293                   
294                    if fsicsdb.Error = True then
295                      MsgBox "Error creating profile, " + fsicsdb.ErrorMessage
296                      fsicsdb.Rollback
297                    else
298                      fsicsdb.Commit
299                      success = true
300                    end if
301                  end if
302                 
303                  Return success
304                End Function
305        #tag EndMethod
306
307        #tag Method, Flags = &h0
308                Sub deleteProfile(theName as String)
309                  if theName <> "" then
310                   
311                    //Delete the profile selected
312                    fsicsdb.SQLExecute("DELETE FROM carprofiles WHERE name = '" + theName + "'")
313                   
314                    //Check for errors
315                    if fsicsdb.Error = True then
316                      MsgBox "Error deleting profile"
317                      fsicsdb.Rollback
318                    else
319                      fsicsdb.Commit
320                    end if
321                   
322                  else
323                   
324                    MsgBox "Please select a profile to delete"
325                   
326                  end if
327                End Sub
328        #tag EndMethod
329
330        #tag Method, Flags = &h0
331                Sub saveProfile(theName as String)
332                  dim rs as RecordSet
333                  dim status as Boolean
334                 
335                  //Find a record
336                  rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
337                 
338                  //Make sure we got a record
339                  if rs <> nil then
340                    //delete the record before saving
341                    deleteProfile(theName)
342                  end if
343                 
344                  rs.Close
345                 
346                  status = createProfile(theName)
347                End Sub
348        #tag EndMethod
349
350        #tag Method, Flags = &h0
351                Function listProfiles() As String()
352                  dim rs as RecordSet
353                  dim s() as string
354                 
355                  //Find records
356                  rs = fsicsdb.SQLSelect("SELECT name FROM carprofiles")
357                 
358                  if rs <> nil then
359                   
360                    while rs.EOF = false
361                      s.Append rs.Field("name").StringValue
362                      rs.MoveNext
363                    wend
364                   
365                  end if
366                 
367                  rs.Close
368                  Return s()
369                End Function
370        #tag EndMethod
371
372
373        #tag Hook, Flags = &h0
374                Event valuesChanged()
375        #tag EndHook
376
377
378        #tag Note, Name = General
379                Car type must be set for this to operate
380                Car types supported by this application are
381                MR-03
382                dNaNo
383                ASF
384        #tag EndNote
385
386
387        #tag Property, Flags = &h0
388                byte01 As String
389        #tag EndProperty
390
391        #tag Property, Flags = &h0
392                byte11 As String
393        #tag EndProperty
394
395        #tag Property, Flags = &h0
396                byte12 As String
397        #tag EndProperty
398
399        #tag Property, Flags = &h0
400                byte13 As String
401        #tag EndProperty
402
403        #tag Property, Flags = &h0
404                byte14 As String
405        #tag EndProperty
406
407        #tag Property, Flags = &h0
408                byte15 As String
409        #tag EndProperty
410
411        #tag Property, Flags = &h0
412                byte16 As String
413        #tag EndProperty
414
415        #tag Property, Flags = &h0
416                byte17 As String
417        #tag EndProperty
418
419        #tag Property, Flags = &h0
420                byte18 As String
421        #tag EndProperty
422
423        #tag Property, Flags = &h0
424                byte02 As String
425        #tag EndProperty
426
427        #tag Property, Flags = &h0
428                byte03 As String
429        #tag EndProperty
430
431        #tag Property, Flags = &h0
432                byte04 As String
433        #tag EndProperty
434
435        #tag Property, Flags = &h0
436                byte05 As String
437        #tag EndProperty
438
439        #tag Property, Flags = &h0
440                byte06 As String
441        #tag EndProperty
442
443        #tag Property, Flags = &h0
444                byte07 As String
445        #tag EndProperty
446
447        #tag Property, Flags = &h0
448                byte08 As String
449        #tag EndProperty
450
451        #tag Property, Flags = &h0
452                byte09 As String
453        #tag EndProperty
454
455        #tag Property, Flags = &h0
456                byte10 As String
457        #tag EndProperty
458
459        #tag Property, Flags = &h0
460                carType As String = "MR-03"
461        #tag EndProperty
462
463        #tag Property, Flags = &h0
464                fsicsdb As REALSQLDatabase
465        #tag EndProperty
466
467        #tag Property, Flags = &h0
468                mode As String = "read"
469        #tag EndProperty
470
471
472        #tag ViewBehavior
473                #tag ViewProperty
474                        Name="Name"
475                        Visible=true
476                        Group="ID"
477                        InheritedFrom="serial"
478                #tag EndViewProperty
479                #tag ViewProperty
480                        Name="Index"
481                        Visible=true
482                        Group="ID"
483                        Type="Integer"
484                        InheritedFrom="serial"
485                #tag EndViewProperty
486                #tag ViewProperty
487                        Name="Super"
488                        Visible=true
489                        Group="ID"
490                        InheritedFrom="serial"
491                #tag EndViewProperty
492                #tag ViewProperty
493                        Name="Left"
494                        Visible=true
495                        Group="Position"
496                        InheritedFrom="serial"
497                #tag EndViewProperty
498                #tag ViewProperty
499                        Name="Top"
500                        Visible=true
501                        Group="Position"
502                        InheritedFrom="serial"
503                #tag EndViewProperty
504                #tag ViewProperty
505                        Name="Baud"
506                        Visible=true
507                        Group="Behavior"
508                        InitialValue="13"
509                        Type="Integer"
510                        EditorType="Enum"
511                        InheritedFrom="serial"
512                        #tag EnumValues
513                                "0 - 300"
514                                "1 - 600"
515                                "2 - 1200"
516                                "3 - 1800"
517                                "4 - 2400"
518                                "5 - 3600"
519                                "6 - 4800"
520                                "7 - 7200"
521                                "8 - 9600"
522                                "9 - 14400"
523                                "10 - 19200"
524                                "11 - 28800"
525                                "12 - 38400"
526                                "13 - 57600"
527                                "14 - 115200"
528                                "15 - 230400"
529                        #tag EndEnumValues
530                #tag EndViewProperty
531                #tag ViewProperty
532                        Name="Bits"
533                        Visible=true
534                        Group="Behavior"
535                        InitialValue="3"
536                        Type="Integer"
537                        EditorType="Enum"
538                        InheritedFrom="serial"
539                        #tag EnumValues
540                                "0 - 5 Data Bits"
541                                "1 - 6 Data Bits"
542                                "2 - 7 Data Bits"
543                                "3 - 8 Data bits"
544                        #tag EndEnumValues
545                #tag EndViewProperty
546                #tag ViewProperty
547                        Name="Parity"
548                        Visible=true
549                        Group="Behavior"
550                        InitialValue="0"
551                        Type="Integer"
552                        EditorType="Enum"
553                        InheritedFrom="serial"
554                        #tag EnumValues
555                                "0 - No Parity"
556                                "1 - Odd Parity"
557                                "2 - EvenParity"
558                        #tag EndEnumValues
559                #tag EndViewProperty
560                #tag ViewProperty
561                        Name="Stop"
562                        Visible=true
563                        Group="Behavior"
564                        InitialValue="0"
565                        Type="Integer"
566                        EditorType="Enum"
567                        InheritedFrom="serial"
568                        #tag EnumValues
569                                "0 - 1 Stop Bit"
570                                "1 - 1.5 Stop Bits"
571                                "2 - 2 Stop Bits"
572                        #tag EndEnumValues
573                #tag EndViewProperty
574                #tag ViewProperty
575                        Name="XON"
576                        Visible=true
577                        Group="Behavior"
578                        Type="Boolean"
579                        InheritedFrom="serial"
580                #tag EndViewProperty
581                #tag ViewProperty
582                        Name="CTS"
583                        Visible=true
584                        Group="Behavior"
585                        Type="Boolean"
586                        InheritedFrom="serial"
587                #tag EndViewProperty
588                #tag ViewProperty
589                        Name="DTR"
590                        Visible=true
591                        Group="Behavior"
592                        Type="Boolean"
593                        InheritedFrom="serial"
594                #tag EndViewProperty
595                #tag ViewProperty
596                        Name="byte01"
597                        Group="Behavior"
598                        InitialValue="&hFF"
599                        Type="String"
600                #tag EndViewProperty
601                #tag ViewProperty
602                        Name="byte11"
603                        Group="Behavior"
604                        Type="String"
605                #tag EndViewProperty
606                #tag ViewProperty
607                        Name="byte12"
608                        Group="Behavior"
609                        Type="String"
610                #tag EndViewProperty
611                #tag ViewProperty
612                        Name="byte13"
613                        Group="Behavior"
614                        Type="String"
615                #tag EndViewProperty
616                #tag ViewProperty
617                        Name="byte14"
618                        Group="Behavior"
619                        Type="String"
620                #tag EndViewProperty
621                #tag ViewProperty
622                        Name="byte15"
623                        Group="Behavior"
624                        Type="String"
625                #tag EndViewProperty
626                #tag ViewProperty
627                        Name="byte16"
628                        Group="Behavior"
629                        Type="String"
630                #tag EndViewProperty
631                #tag ViewProperty
632                        Name="byte17"
633                        Group="Behavior"
634                        Type="String"
635                #tag EndViewProperty
636                #tag ViewProperty
637                        Name="byte18"
638                        Group="Behavior"
639                        Type="String"
640                #tag EndViewProperty
641                #tag ViewProperty
642                        Name="byte02"
643                        Group="Behavior"
644                        Type="String"
645                #tag EndViewProperty
646                #tag ViewProperty
647                        Name="byte03"
648                        Group="Behavior"
649                        Type="String"
650                #tag EndViewProperty
651                #tag ViewProperty
652                        Name="byte04"
653                        Group="Behavior"
654                        Type="String"
655                #tag EndViewProperty
656                #tag ViewProperty
657                        Name="byte05"
658                        Group="Behavior"
659                        Type="String"
660                #tag EndViewProperty
661                #tag ViewProperty
662                        Name="byte06"
663                        Group="Behavior"
664                        Type="String"
665                #tag EndViewProperty
666                #tag ViewProperty
667                        Name="byte07"
668                        Group="Behavior"
669                        Type="String"
670                #tag EndViewProperty
671                #tag ViewProperty
672                        Name="byte08"
673                        Group="Behavior"
674                        Type="String"
675                #tag EndViewProperty
676                #tag ViewProperty
677                        Name="byte09"
678                        Group="Behavior"
679                        Type="String"
680                #tag EndViewProperty
681                #tag ViewProperty
682                        Name="byte10"
683                        Group="Behavior"
684                        Type="String"
685                #tag EndViewProperty
686        #tag EndViewBehavior
687End Class
688#tag EndClass
Note: See TracBrowser for help on using the repository browser.