source: trunk/desktop/ICSSerialPort.rbbas @ 48

Revision 48, 28.2 KB checked in by pinwc4, 15 years ago (diff)

Fixed bug with new method for reopening COM port every time the program reads or writes. This will allow people to unplug the cable from the computer and plug it back in while the program is running.

Line 
1#tag Class
2Protected Class ICSSerialPort
3Inherits serial
4        #tag Event
5                Sub DataAvailable()
6                  //Add to the buffer first
7                 
8                  buffer = buffer + me.ReadAll
9                 
10                  //Figure out if we need to do anything
11                 
12                  select case mode
13                   
14                  case "read"
15                    dim flagstart as integer
16                    dim datastart as integer
17                   
18                    //We need to decode the packet to figure out the values
19                   
20                    //First we need to make sure we have enough data
21                    //If not we need to wait for more
22                   
23                    flagstart = InStrb(buffer, ChrB(&h5A))
24                   
25                    if flagstart = 0 then
26                      //We did not find a match so we can discard the data and wait for more
27                      buffer =  ""
28                      return
29                    ElseIf lenb(buffer) < 17 + flagStart - 1 then
30                      // we do not have a complete packet return and wait
31                      return
32                    end if
33                   
34                    datastart = flagstart + 1
35                   
36                    byte03 = midb(buffer, datastart, 1)
37                    byte04 = midb(buffer, datastart+1, 1)
38                    byte05 = midb(buffer, datastart+2, 1)
39                    byte06 = midb(buffer, datastart+3, 1)
40                    byte07 = midb(buffer, datastart+4, 1)
41                    byte08 = midb(buffer, datastart+5, 1)
42                    byte09 = midb(buffer, datastart+6, 1)
43                    byte10 = midb(buffer, datastart+7, 1)
44                    byte11 = midb(buffer, datastart+8, 1)
45                    byte12 = midb(buffer, datastart+9, 1)
46                    byte13 = midb(buffer, datastart+10, 1)
47                    byte14 = midb(buffer, datastart+11, 1)
48                    byte15 = midb(buffer, datastart+12, 1)
49                    byte16 = midb(buffer, datastart+13, 1)
50                    byte17 = midb(buffer, datastart+14, 1)
51                   
52                    valuesChanged()
53                   
54                  else
55                   
56                    //We do not care about the data, discard it
57                    buffer = ""
58                   
59                  end select
60                End Sub
61        #tag EndEvent
62
63
64        #tag Method, Flags = &h0
65                Sub calculateChecksum()
66                  //Use this to calculate byte 18, the checksum
67                  //The checksum is just adding bytes 2-17 together but rounded at each byte
68                 
69                  dim i as integer
70                 
71                  i = (asc(byte02) + asc(byte03)) mod &h100
72                  i = (i + asc(byte04)) mod &h100
73                  i = (i + asc(byte05)) mod &h100
74                  i = (i + asc(byte06)) mod &h100
75                  i = (i + asc(byte07)) mod &h100
76                  i = (i + asc(byte08)) mod &h100
77                  i = (i + asc(byte09)) mod &h100
78                  i = (i + asc(byte10)) mod &h100
79                  i = (i + asc(byte11)) mod &h100
80                  i = (i + asc(byte12)) mod &h100
81                  i = (i + asc(byte13)) mod &h100
82                  i = (i + asc(byte14)) mod &h100
83                  i = (i + asc(byte15)) mod &h100
84                  i = (i + asc(byte16)) mod &h100
85                  i = (i + asc(byte17)) mod &h100
86                 
87                  byte18 = chrb(i)
88                End Sub
89        #tag EndMethod
90
91        #tag Method, Flags = &h0
92                Sub Constructor()
93                  //Make sure we have a database and if not create it
94                  dim exists as boolean
95                 
96                  exists = prepareDB()
97                  if exists = false then
98                    //No database available, create one
99                    createDB()
100                  else
101                    //Database exists, connect to it
102                    if fsicsdb.Connect = false then
103                      MsgBox "Database connection failed"
104                    end if
105                  end if
106                 
107                  //Set default byte values
108                  byte01 = chrb(&hD5)
109                  byte02 = chrb(&h5A)
110                  byte03 = chrb(&h64)
111                  byte04 = chrb(&hFF)
112                  byte05 = chrb(&h02)
113                  byte06 = chrb(&h02)
114                  byte07 = chrb(&h01)
115                  byte08 = chrb(&hFF)
116                  byte09 = chrb(&hBC)
117                  byte10 = chrb(&h44)
118                  byte11 = chrb(&h88)
119                  byte12 = chrb(&h78)
120                  byte13 = chrb(&hFF)
121                  byte14 = chrb(&h2C)
122                  byte15 = chrb(&h05)
123                  byte16 = chrb(&h5A)
124                  byte17 = chrb(&h3C)
125                  byte18 = chrb(&h87)
126                 
127                  carType = "MR-03"
128                End Sub
129        #tag EndMethod
130
131        #tag Method, Flags = &h21
132                Private Sub createDB()
133                  //Create a new database
134                 
135                 
136                  //make sure we can create the file
137                  if fsicsdb.CreateDatabaseFile() then
138                    if fsicsdb.Connect() then
139                      dim query as string
140                      query = "CREATE TABLE carprofiles (id INTEGER PRIMARY KEY, name VARCHAR, cartype VARCHAR, byte01 INTEGER, byte02 INTEGER, byte03 INTEGER, byte04 INTEGER, byte05 INTEGER, byte06 INTEGER"+_
141                      ", byte07 INTEGER, byte08 INTEGER, byte09 INTEGER, byte10 INTEGER, byte11 INTEGER, byte12 INTEGER, byte13 INTEGER, byte14 INTEGER, byte15 INTEGER, byte16 INTEGER, byte17 INTEGER"+_
142                      ", byte18 INTEGER, UNIQUE(name))"
143                      fsicsdb.SQLExecute(query)
144                      if fsicsdb.Error then
145                        MsgBox "Database Error (carprofiles):" + fsicsdb.ErrorMessage
146                        fsicsdb.Rollback
147                       
148                      else
149                        fsicsdb.Commit
150                      end if
151                     
152                     
153                    else
154                      MsgBox "Failed to connect to new database file"
155                    end if
156                  else
157                    //Failed to create database file
158                    MsgBox "Failed to create database file"
159                  end if
160                End Sub
161        #tag EndMethod
162
163        #tag Method, Flags = &h0
164                Function createProfile(theName as String) As Boolean
165                  dim success as boolean
166                  success = false
167                 
168                  //Make sure we got a name
169                  if theName = "" then
170                    return success
171                  else
172                    //Build a new database record
173                    dim rec as DatabaseRecord
174                    rec = New DatabaseRecord
175                   
176                    rec.Column("name") = theName
177                    rec.Column("cartype") = carType
178                    rec.IntegerColumn("byte01") = asc(byte01)
179                    rec.IntegerColumn("byte02") = asc(byte02)
180                    rec.IntegerColumn("byte03") = asc(byte03)
181                    rec.IntegerColumn("byte04") = asc(byte04)
182                    rec.IntegerColumn("byte05") = asc(byte05)
183                    rec.IntegerColumn("byte06") = asc(byte06)
184                    rec.IntegerColumn("byte07") = asc(byte07)
185                    rec.IntegerColumn("byte08") = asc(byte08)
186                    rec.IntegerColumn("byte09") = asc(byte09)
187                    rec.IntegerColumn("byte10") = asc(byte10)
188                    rec.IntegerColumn("byte11") = asc(byte11)
189                    rec.IntegerColumn("byte12") = asc(byte12)
190                    rec.IntegerColumn("byte13") = asc(byte13)
191                    rec.IntegerColumn("byte14") = asc(byte14)
192                    rec.IntegerColumn("byte15") = asc(byte15)
193                    rec.IntegerColumn("byte16") = asc(byte16)
194                    rec.IntegerColumn("byte17") = asc(byte17)
195                    rec.IntegerColumn("byte18") = asc(byte18)
196                   
197                    fsicsdb.InsertRecord("carprofiles", rec)
198                   
199                    if fsicsdb.Error = True then
200                      MsgBox "Error creating profile, " + fsicsdb.ErrorMessage
201                      fsicsdb.Rollback
202                    else
203                      fsicsdb.Commit
204                      success = true
205                    end if
206                  end if
207                 
208                  Return success
209                End Function
210        #tag EndMethod
211
212        #tag Method, Flags = &h0
213                Sub deleteProfile(theName as String)
214                  if theName <> "" then
215                   
216                    //Delete the profile selected
217                    fsicsdb.SQLExecute("DELETE FROM carprofiles WHERE name = '" + theName + "'")
218                   
219                    //Check for errors
220                    if fsicsdb.Error = True then
221                      MsgBox "Error deleting profile"
222                      fsicsdb.Rollback
223                    else
224                      fsicsdb.Commit
225                    end if
226                   
227                  else
228                   
229                    MsgBox "Please select a profile to delete"
230                   
231                  end if
232                End Sub
233        #tag EndMethod
234
235        #tag Method, Flags = &h0
236                Sub exportProfile(theName as string)
237                  dim xml as XmlDocument
238                  dim root as XmlNode
239                  dim rootchild as XmlNode
240                  dim rs as RecordSet
241                  dim i as integer
242                  dim dlg as SaveAsDialog
243                  dim f as FolderItem
244                 
245                  dlg = New SaveAsDialog
246                  dlg.Title = "Export your profile"
247                  #if TargetLinux
248                    dlg.InitialDirectory = SpecialFolder.Home
249                  #else
250                    dlg.InitialDirectory = SpecialFolder.Documents
251                  #endif
252                 
253                  dlg.SuggestedFileName = "ics_"+theName+".xml"
254                  f = dlg.ShowModal()
255                 
256                  if f <> Nil then
257                    //Nothing to see here, move along
258                  else
259                    MsgBox "You must choose a file"
260                    Return
261                  end if
262                 
263                  //Find the record
264                  rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
265                 
266                  if rs <> Nil then
267                    //We have a record, so do something
268                   
269                    //Create the root element of the XML file
270                    xml = New XmlDocument
271                    root = xml.AppendChild(xml.CreateElement("icsprofile"))
272                   
273                    //Itterate all available fields and write them to the xml document
274                    for i = 1 to rs.FieldCount
275                      if rs.IdxField(i).Name <> "" and rs.IdxField(i).StringValue<> "" then
276                       
277                        rootchild = root.AppendChild(xml.CreateElement(rs.IdxField(i).Name))
278                        rootchild.AppendChild(xml.CreateTextNode(rs.IdxField(i).StringValue))
279                      end if
280                    next
281                   
282                    //Write the document to a file
283                    xml.SaveXml(f)
284                  else
285                    MsgBox "No profile to export"
286                    Return
287                  end if
288                 
289                End Sub
290        #tag EndMethod
291
292        #tag Method, Flags = &h0
293                Function importProfile() As Boolean
294                  dim success as boolean
295                  dim dlg as OpenDialog
296                  dim f as FolderItem
297                  dim xdoc as XmlDocument
298                  dim root as XmlNode
299                  dim i as integer
300                  dim count as Integer
301                  dim item as string
302                  dim rec as DatabaseRecord
303                  dim theName as string
304                 
305                  rec = New DatabaseRecord
306                  success = False
307                 
308                 
309                  //Get the user to select a file
310                  dlg = New OpenDialog
311                  dlg.Title = "Select a profile to import"
312                  #if TargetLinux
313                    dlg.InitialDirectory = SpecialFolder.Home
314                  #else
315                    dlg.InitialDirectory = SpecialFolder.Documents
316                  #endif
317                  f = dlg.ShowModal()
318                 
319                  //If we have a valid file we need to read it as an xml file to process it
320                  //Items are individually specified to prevent the program from trying to insert columns that do not exist
321                  //All column names should match the database table
322                 
323                  if f <> nil then
324                   
325                    //Read the XML file
326                    xdoc = New XmlDocument(f)
327                   
328                    count = xdoc.DocumentElement.ChildCount
329                   
330                    for i = 0 to count - 1
331                      root = xdoc.DocumentElement.Child(i)
332                     
333                      item = root.FirstChild.Value
334                     
335                      select case root.Name
336                       
337                      case "name"
338                        theName = item
339                      case "cartype"
340                        carType = item
341                      case "byte01"
342                        byte01 = chrb(val(item))
343                      case "byte02"
344                        byte02 = chrb(val(item))
345                      case "byte03"
346                        byte03 = chrb(val(item))
347                      case "byte04"
348                        byte04 = chrb(val(item))
349                      case "byte05"
350                        byte05 = chrb(val(item))
351                      case "byte06"
352                        byte06 = chrb(val(item))
353                      case "byte07"
354                        byte07 = chrb(val(item))
355                      case "byte08"
356                        byte08 = chrb(val(item))
357                      case "byte09"
358                        byte09 = chrb(val(item))
359                      case "byte10"
360                        byte10 = chrb(val(item))
361                      case "byte11"
362                        byte11 = chrb(val(item))
363                      case "byte12"
364                        byte12 = chrb(val(item))
365                      case "byte13"
366                        byte13 = chrb(val(item))
367                      case "byte14"
368                        byte14 = chrb(val(item))
369                      case "byte15"
370                        byte15 = chrb(val(item))
371                      case "byte16"
372                        byte16 = chrb(val(item))
373                      case "byte17"
374                        byte17 = chrb(val(item))
375                      case "byte18"
376                        byte18 = chrb(val(item))
377                       
378                      end select
379                     
380                    next
381                   
382                  else
383                    //File not select we can stop
384                    success = False
385                    return success
386                  end if
387                 
388                  //Now check to make sure their is not an existing profile with this name
389                  dim rs as RecordSet
390                 
391                  rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
392                 
393                  if rs <> Nil then
394                   
395                    if rs.RecordCount > 0 then
396                      //we have a duplicate record
397                      //we need to prompt the user about what to do
398                      dim d as New MessageDialog
399                      dim b as MessageDialogButton
400                      d.Icon = MessageDialog.GraphicCaution
401                      d.ActionButton.Caption = "Yes"
402                      d.CancelButton.Visible = True
403                      d.CancelButton.Caption = "No"
404                      d.Message = "A profile exists with this name, do you want to overwrite the existing profile?"
405                      b = d.ShowModal
406                     
407                      //Now determine what the user chose
408                      Select Case b
409                      case d.ActionButton
410                        //The user wants to overwrite the record so we can just save what we have
411                        saveProfile(theName)
412                        success = True
413                        //Values changed because of the overwrite
414                        valuesChanged()
415                      case d.CancelButton
416                        //The user chose not to overwrite the record, we need to come up with a new name
417                        //We will increment the number until we find a name not used or we hit 32 just in case an infinite loop would occur
418                        dim tempString as string
419                        dim tempName as string
420                        i = 0
421                        while rs.RecordCount > 0
422                          i = i + 1
423                          tempString = str(i)
424                          tempName = theName + tempString
425                          //Check to make sure we are not in an infinite looooooooop
426                          //If we are something went wrong
427                          if i > 31 then
428                            exit While
429                          end if
430                          rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name = '"+tempName+"'")
431                         
432                        wend
433                        //OK we have a unique name at this point
434                        theName = theName + tempString
435                        saveProfile(theName)
436                        success = True
437                        //new profile was imported
438                        profileImported(theName)
439                      end select
440                     
441                    else
442                      //No duplicate exists so we can just insert the record
443                      saveProfile(theName)
444                      success = True
445                      //new profile was imported
446                      profileImported(theName)
447                    end if
448                    //Close our record
449                    rs.Close
450                   
451                  end if
452                 
453                  Return success
454                 
455                End Function
456        #tag EndMethod
457
458        #tag Method, Flags = &h0
459                Function listProfiles() As String()
460                  dim rs as RecordSet
461                  dim s() as string
462                 
463                  //Find records
464                  rs = fsicsdb.SQLSelect("SELECT name FROM carprofiles")
465                 
466                  if rs <> nil then
467                   
468                    while rs.EOF = false
469                      s.Append rs.Field("name").StringValue
470                      rs.MoveNext
471                    wend
472                   
473                  end if
474                 
475                  rs.Close
476                  Return s()
477                End Function
478        #tag EndMethod
479
480        #tag Method, Flags = &h0
481                Sub loadProfile(theName as string)
482                  //Find the profile in the database, update the bytes and fire the event
483                  dim rs as RecordSet
484                 
485                  rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
486                 
487                  //Make sure we got a record to work with
488                  if rs <> Nil then
489                   
490                    if rs.Field("cartype").StringValue <> "" then
491                      carType = rs.Field("cartype").StringValue
492                    end if
493                   
494                    if rs.Field("byte01").StringValue <> "" then
495                      byte01 = chrb(rs.Field("byte01").IntegerValue)
496                    end if
497                    if rs.Field("byte02").StringValue <> "" then
498                      byte02 = chrb(rs.Field("byte02").IntegerValue)
499                    end if
500                    if rs.Field("byte03").StringValue <> "" then
501                      byte03 = chrb(rs.Field("byte03").IntegerValue)
502                    end if
503                    if rs.Field("byte04").StringValue <> "" then
504                      byte04 = chrb(rs.Field("byte04").IntegerValue)
505                    end if
506                    if rs.Field("byte05").StringValue <> "" then
507                      byte05 = chrb(rs.Field("byte05").IntegerValue)
508                    end if
509                    if rs.Field("byte06").StringValue <> "" then
510                      byte06 = chrb(rs.Field("byte06").IntegerValue)
511                    end if
512                    if rs.Field("byte07").StringValue <> "" then
513                      byte07 = chrb(rs.Field("byte07").IntegerValue)
514                    end if
515                    if rs.Field("byte08").StringValue <> "" then
516                      byte08 = chrb(rs.Field("byte08").IntegerValue)
517                    end if
518                    if rs.Field("byte09").StringValue <> "" then
519                      byte09 = chrb(rs.Field("byte09").IntegerValue)
520                    end if
521                    if rs.Field("byte10").StringValue <> "" then
522                      byte10 = chrb(rs.Field("byte10").IntegerValue)
523                    end if
524                    if rs.Field("byte11").StringValue <> "" then
525                      byte11 = chrb(rs.Field("byte11").IntegerValue)
526                    end if
527                    if rs.Field("byte12").StringValue <> "" then
528                      byte12 = chrb(rs.Field("byte12").IntegerValue)
529                    end if
530                    if rs.Field("byte13").StringValue <> "" then
531                      byte13 = chrb(rs.Field("byte13").IntegerValue)
532                    end if
533                    if rs.Field("byte14").StringValue <> "" then
534                      byte14 = chrb(rs.Field("byte14").IntegerValue)
535                    end if
536                    if rs.Field("byte15").StringValue <> "" then
537                      byte15 = chrb(rs.Field("byte15").IntegerValue)
538                    end if
539                    if rs.Field("byte16").StringValue <> "" then
540                      byte16 = chrb(rs.Field("byte16").IntegerValue)
541                    end if
542                    if rs.Field("byte17").StringValue <> "" then
543                      byte17 = chrb(rs.Field("byte17").IntegerValue)
544                    end if
545                    if rs.Field("byte18").StringValue <> "" then
546                      byte18 = chrb(rs.Field("byte18").IntegerValue)
547                    end if
548                   
549                    valuesChanged()
550                  end if
551                End Sub
552        #tag EndMethod
553
554        #tag Method, Flags = &h21
555                Private Function prepareDB() As Boolean
556                  //Open the database file
557                  fsicsdb = new REALSQLDatabase
558                  dim f as FolderItem = GetFolderItem("fsicsdb")
559                  fsicsdb.DatabaseFile = f
560                 
561                  return f.Exists
562                End Function
563        #tag EndMethod
564
565        #tag Method, Flags = &h0
566                Sub readCar()
567                  dim portstatus as boolean
568                  //Reopen the port just in case communication was interrupted previously
569                  //This will return true if the port is opened
570                  portstatus = reOpenPort
571                 
572                  if portstatus = true then
573                    //Read values from the currently attached car
574                    dim sendstring as string
575                   
576                    mode = "read"
577                   
578                    sendstring = chrb(&hC5)
579                   
580                    me.Write(sendstring)
581                  end if
582                End Sub
583        #tag EndMethod
584
585        #tag Method, Flags = &h21
586                Private Function reOpenPort() As Boolean
587                  dim status as boolean
588                  //Set the return code to false unless the port successfully opens
589                  status = false
590                 
591                  //First close the port just in case
592                  me.Close
593                 
594                  if not me.Open then
595                    //Could not open
596                    MsgBox "Error opening defined com port"
597                  else
598                    status = true
599                  end if
600                 
601                  return status
602                End Function
603        #tag EndMethod
604
605        #tag Method, Flags = &h0
606                Sub resetCar()
607                  //This sends the command to reset the car back to a default configuration
608                  //Defaults are different for each car type
609                  setDefaultValues
610                 
611                  //Send the default values to the car
612                  writeCar
613                End Sub
614        #tag EndMethod
615
616        #tag Method, Flags = &h0
617                Sub saveProfile(theName as String)
618                  if theName <> "" then
619                   
620                    dim rs as RecordSet
621                    dim status as Boolean
622                   
623                    //Find a record
624                    rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
625                   
626                    //Make sure we got a record
627                    if rs <> nil then
628                      //delete the record before saving
629                      deleteProfile(theName)
630                    end if
631                   
632                    rs.Close
633                   
634                    status = createProfile(theName)
635                   
636                  else
637                   
638                    MsgBox "Please select a profile to modify"
639                   
640                  end if
641                End Sub
642        #tag EndMethod
643
644        #tag Method, Flags = &h0
645                Sub setCarType(value as string)
646                  //When setting car type we must reconfigure the serial port
647                  //Some car types have a different baud rate
648                 
649                  select case value
650                   
651                  case "MR-03"
652                    carType = value
653                    byte15 = chrb(&h05)
654                    byte16 = chrb(&h5A)
655                    byte17 = chrb(&h3C)
656                  case "dNaNo"
657                    carType = value
658                    byte15 = chrb(&hFF)
659                    byte16 = chrb(&h80)
660                    byte17 = chrb(&h80)
661                  case "ASF"
662                    carType = value
663                    byte15 = chrb(&hFF)
664                    byte16 = chrb(&hFF)
665                    byte17 = chrb(&hFF)
666                   
667                  else
668                    MsgBox "Error setting Car Type"
669                  end select
670                 
671                  valuesChanged()
672                End Sub
673        #tag EndMethod
674
675        #tag Method, Flags = &h0
676                Sub setDefaultValues()
677                  //Set the defaults for the bytes sent to a car
678                 
679                  select case carType
680                   
681                  case "MR-03"
682                    byte01 = chrb(&hD5)
683                    byte02 = chrb(&h5A)
684                    byte03 = chrb(&h64)
685                    byte04 = chrb(&hFF)
686                    byte05 = chrb(&h02)
687                    byte06 = chrb(&h02)
688                    byte07 = chrb(&h01)
689                    byte08 = chrb(&hFF)
690                    byte09 = chrb(&hBC)
691                    byte10 = chrb(&h44)
692                    byte11 = chrb(&h88)
693                    byte12 = chrb(&h78)
694                    byte13 = chrb(&hFF)
695                    byte14 = chrb(&h2C)
696                    byte15 = chrb(&h05)
697                    byte16 = chrb(&h5A)
698                    byte17 = chrb(&h3C)
699                    byte18 = chrb(&h87)
700                   
701                  case "dNaNo"
702                    byte01 = chrb(&hD5)
703                    byte02 = chrb(&h5A)
704                    byte03 = chrb(&hFF)
705                    byte04 = chrb(&hFF)
706                    byte05 = chrb(&h0A)
707                    byte06 = chrb(&h03)
708                    byte07 = chrb(&h01)
709                    byte08 = chrb(&h40)
710                    byte09 = chrb(&hBC)
711                    byte10 = chrb(&h44)
712                    byte11 = chrb(&h88)
713                    byte12 = chrb(&h78)
714                    byte13 = chrb(&h03)
715                    byte14 = chrb(&hFF)
716                    byte15 = chrb(&hFF)
717                    byte16 = chrb(&h80)
718                    byte17 = chrb(&h80)
719                    byte18 = chrb(&hA7)
720                   
721                  case "ASF"
722                    byte01 = chrb(&hD5)
723                    byte02 = chrb(&h5A)
724                    byte03 = chrb(&hFF)
725                    byte04 = chrb(&hFF)
726                    byte05 = chrb(&h0A)
727                    byte06 = chrb(&h03)
728                    byte07 = chrb(&h01)
729                    byte08 = chrb(&h78)
730                    byte09 = chrb(&hBC)
731                    byte10 = chrb(&h44)
732                    byte11 = chrb(&h88)
733                    byte12 = chrb(&h78)
734                    byte13 = chrb(&h03)
735                    byte14 = chrb(&hFF)
736                    byte15 = chrb(&hFF)
737                    byte16 = chrb(&hFF)
738                    byte17 = chrb(&hFF)
739                    byte18 = chrb(&hDD)
740                   
741                  else
742                    //default thing to do
743                    MsgBox "Error invalid car type"
744                    return
745                  end select
746                 
747                  //trigger the event definition so main program knows the values changed
748                  valuesChanged()
749                End Sub
750        #tag EndMethod
751
752        #tag Method, Flags = &h0
753                Sub writeCar()
754                  dim portstatus as boolean
755                  //Reopen the port just in case communication was interrupted previously
756                  //This will return true if the port is opened
757                  portstatus = reOpenPort
758                 
759                  if portstatus = true then
760                   
761                    //Send set bytes to the car
762                    mode = "write"
763                   
764                    dim sendstring as string
765                   
766                    calculateChecksum()
767                   
768                    sendstring = byte01 + byte02 + byte03 + byte04 + byte05 + byte06 + byte07 + byte08 + byte09 + byte10 + byte11 + byte12 + byte13 + byte14 + byte15 + byte16 + byte17 + byte18
769                   
770                    me.Write(sendstring)
771                   
772                  end if
773                End Sub
774        #tag EndMethod
775
776
777        #tag Hook, Flags = &h0
778                Event profileImported(profileName as string)
779        #tag EndHook
780
781        #tag Hook, Flags = &h0
782                Event valuesChanged()
783        #tag EndHook
784
785
786        #tag Note, Name = General
787                Car type must be set for this to operate
788                Car types supported by this application are
789                MR-03
790                dNaNo
791                ASF
792        #tag EndNote
793
794        #tag Note, Name = License
795                Copyright 2010 Jeremy Auten
796               
797                This file is part of Flip Side ICS Software.
798               
799                Flip Side ICS Software is free software: you can redistribute it and/or modify
800                it under the terms of the GNU General Public License as published by
801                the Free Software Foundation, either version 3 of the License, or
802                (at your option) any later version.
803               
804                Flip Side ICS Software is distributed in the hope that it will be useful,
805                but WITHOUT ANY WARRANTY; without even the implied warranty of
806                MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
807                GNU General Public License for more details.
808               
809                You should have received a copy of the GNU General Public License
810                along with Flip Side ICS Software.  If not, see <http://www.gnu.org/licenses/>.
811        #tag EndNote
812
813
814        #tag Property, Flags = &h21
815                Private buffer As String
816        #tag EndProperty
817
818        #tag Property, Flags = &h0
819                byte01 As String
820        #tag EndProperty
821
822        #tag Property, Flags = &h0
823                byte02 As String
824        #tag EndProperty
825
826        #tag Property, Flags = &h0
827                byte03 As String
828        #tag EndProperty
829
830        #tag Property, Flags = &h0
831                byte04 As String
832        #tag EndProperty
833
834        #tag Property, Flags = &h0
835                byte05 As String
836        #tag EndProperty
837
838        #tag Property, Flags = &h0
839                byte06 As String
840        #tag EndProperty
841
842        #tag Property, Flags = &h0
843                byte07 As String
844        #tag EndProperty
845
846        #tag Property, Flags = &h0
847                byte08 As String
848        #tag EndProperty
849
850        #tag Property, Flags = &h0
851                byte09 As String
852        #tag EndProperty
853
854        #tag Property, Flags = &h0
855                byte10 As String
856        #tag EndProperty
857
858        #tag Property, Flags = &h0
859                byte11 As String
860        #tag EndProperty
861
862        #tag Property, Flags = &h0
863                byte12 As String
864        #tag EndProperty
865
866        #tag Property, Flags = &h0
867                byte13 As String
868        #tag EndProperty
869
870        #tag Property, Flags = &h0
871                byte14 As String
872        #tag EndProperty
873
874        #tag Property, Flags = &h0
875                byte15 As String
876        #tag EndProperty
877
878        #tag Property, Flags = &h0
879                byte16 As String
880        #tag EndProperty
881
882        #tag Property, Flags = &h0
883                byte17 As String
884        #tag EndProperty
885
886        #tag Property, Flags = &h0
887                byte18 As String
888        #tag EndProperty
889
890        #tag Property, Flags = &h0
891                carType As String = "MR-03"
892        #tag EndProperty
893
894        #tag Property, Flags = &h0
895                fsicsdb As REALSQLDatabase
896        #tag EndProperty
897
898        #tag Property, Flags = &h21
899                Private mode As String = "none"
900        #tag EndProperty
901
902
903        #tag ViewBehavior
904                #tag ViewProperty
905                        Name="Baud"
906                        Visible=true
907                        Group="Behavior"
908                        InitialValue="13"
909                        Type="Integer"
910                        EditorType="Enum"
911                        InheritedFrom="serial"
912                        #tag EnumValues
913                                "0 - 300"
914                                "1 - 600"
915                                "2 - 1200"
916                                "3 - 1800"
917                                "4 - 2400"
918                                "5 - 3600"
919                                "6 - 4800"
920                                "7 - 7200"
921                                "8 - 9600"
922                                "9 - 14400"
923                                "10 - 19200"
924                                "11 - 28800"
925                                "12 - 38400"
926                                "13 - 57600"
927                                "14 - 115200"
928                                "15 - 230400"
929                        #tag EndEnumValues
930                #tag EndViewProperty
931                #tag ViewProperty
932                        Name="Bits"
933                        Visible=true
934                        Group="Behavior"
935                        InitialValue="3"
936                        Type="Integer"
937                        EditorType="Enum"
938                        InheritedFrom="serial"
939                        #tag EnumValues
940                                "0 - 5 Data Bits"
941                                "1 - 6 Data Bits"
942                                "2 - 7 Data Bits"
943                                "3 - 8 Data bits"
944                        #tag EndEnumValues
945                #tag EndViewProperty
946                #tag ViewProperty
947                        Name="byte01"
948                        Group="Behavior"
949                        InitialValue="&hFF"
950                        Type="String"
951                        EditorType="MultiLineEditor"
952                #tag EndViewProperty
953                #tag ViewProperty
954                        Name="byte02"
955                        Group="Behavior"
956                        Type="String"
957                        EditorType="MultiLineEditor"
958                #tag EndViewProperty
959                #tag ViewProperty
960                        Name="byte03"
961                        Group="Behavior"
962                        Type="String"
963                        EditorType="MultiLineEditor"
964                #tag EndViewProperty
965                #tag ViewProperty
966                        Name="byte04"
967                        Group="Behavior"
968                        Type="String"
969                        EditorType="MultiLineEditor"
970                #tag EndViewProperty
971                #tag ViewProperty
972                        Name="byte05"
973                        Group="Behavior"
974                        Type="String"
975                        EditorType="MultiLineEditor"
976                #tag EndViewProperty
977                #tag ViewProperty
978                        Name="byte06"
979                        Group="Behavior"
980                        Type="String"
981                        EditorType="MultiLineEditor"
982                #tag EndViewProperty
983                #tag ViewProperty
984                        Name="byte07"
985                        Group="Behavior"
986                        Type="String"
987                        EditorType="MultiLineEditor"
988                #tag EndViewProperty
989                #tag ViewProperty
990                        Name="byte08"
991                        Group="Behavior"
992                        Type="String"
993                        EditorType="MultiLineEditor"
994                #tag EndViewProperty
995                #tag ViewProperty
996                        Name="byte09"
997                        Group="Behavior"
998                        Type="String"
999                        EditorType="MultiLineEditor"
1000                #tag EndViewProperty
1001                #tag ViewProperty
1002                        Name="byte10"
1003                        Group="Behavior"
1004                        Type="String"
1005                        EditorType="MultiLineEditor"
1006                #tag EndViewProperty
1007                #tag ViewProperty
1008                        Name="byte11"
1009                        Group="Behavior"
1010                        Type="String"
1011                        EditorType="MultiLineEditor"
1012                #tag EndViewProperty
1013                #tag ViewProperty
1014                        Name="byte12"
1015                        Group="Behavior"
1016                        Type="String"
1017                        EditorType="MultiLineEditor"
1018                #tag EndViewProperty
1019                #tag ViewProperty
1020                        Name="byte13"
1021                        Group="Behavior"
1022                        Type="String"
1023                        EditorType="MultiLineEditor"
1024                #tag EndViewProperty
1025                #tag ViewProperty
1026                        Name="byte14"
1027                        Group="Behavior"
1028                        Type="String"
1029                        EditorType="MultiLineEditor"
1030                #tag EndViewProperty
1031                #tag ViewProperty
1032                        Name="byte15"
1033                        Group="Behavior"
1034                        Type="String"
1035                        EditorType="MultiLineEditor"
1036                #tag EndViewProperty
1037                #tag ViewProperty
1038                        Name="byte16"
1039                        Group="Behavior"
1040                        Type="String"
1041                        EditorType="MultiLineEditor"
1042                #tag EndViewProperty
1043                #tag ViewProperty
1044                        Name="byte17"
1045                        Group="Behavior"
1046                        Type="String"
1047                        EditorType="MultiLineEditor"
1048                #tag EndViewProperty
1049                #tag ViewProperty
1050                        Name="byte18"
1051                        Group="Behavior"
1052                        Type="String"
1053                        EditorType="MultiLineEditor"
1054                #tag EndViewProperty
1055                #tag ViewProperty
1056                        Name="carType"
1057                        Group="Behavior"
1058                        InitialValue="MR-03"
1059                        Type="String"
1060                        EditorType="MultiLineEditor"
1061                #tag EndViewProperty
1062                #tag ViewProperty
1063                        Name="CTS"
1064                        Visible=true
1065                        Group="Behavior"
1066                        Type="Boolean"
1067                        InheritedFrom="serial"
1068                #tag EndViewProperty
1069                #tag ViewProperty
1070                        Name="DTR"
1071                        Visible=true
1072                        Group="Behavior"
1073                        Type="Boolean"
1074                        InheritedFrom="serial"
1075                #tag EndViewProperty
1076                #tag ViewProperty
1077                        Name="Index"
1078                        Visible=true
1079                        Group="ID"
1080                        Type="Integer"
1081                        InheritedFrom="serial"
1082                #tag EndViewProperty
1083                #tag ViewProperty
1084                        Name="Left"
1085                        Visible=true
1086                        Group="Position"
1087                        InheritedFrom="serial"
1088                #tag EndViewProperty
1089                #tag ViewProperty
1090                        Name="Name"
1091                        Visible=true
1092                        Group="ID"
1093                        InheritedFrom="serial"
1094                #tag EndViewProperty
1095                #tag ViewProperty
1096                        Name="Parity"
1097                        Visible=true
1098                        Group="Behavior"
1099                        InitialValue="0"
1100                        Type="Integer"
1101                        EditorType="Enum"
1102                        InheritedFrom="serial"
1103                        #tag EnumValues
1104                                "0 - No Parity"
1105                                "1 - Odd Parity"
1106                                "2 - EvenParity"
1107                        #tag EndEnumValues
1108                #tag EndViewProperty
1109                #tag ViewProperty
1110                        Name="Stop"
1111                        Visible=true
1112                        Group="Behavior"
1113                        InitialValue="0"
1114                        Type="Integer"
1115                        EditorType="Enum"
1116                        InheritedFrom="serial"
1117                        #tag EnumValues
1118                                "0 - 1 Stop Bit"
1119                                "1 - 1.5 Stop Bits"
1120                                "2 - 2 Stop Bits"
1121                        #tag EndEnumValues
1122                #tag EndViewProperty
1123                #tag ViewProperty
1124                        Name="Super"
1125                        Visible=true
1126                        Group="ID"
1127                        InheritedFrom="serial"
1128                #tag EndViewProperty
1129                #tag ViewProperty
1130                        Name="Top"
1131                        Visible=true
1132                        Group="Position"
1133                        InheritedFrom="serial"
1134                #tag EndViewProperty
1135                #tag ViewProperty
1136                        Name="XON"
1137                        Visible=true
1138                        Group="Behavior"
1139                        Type="Boolean"
1140                        InheritedFrom="serial"
1141                #tag EndViewProperty
1142        #tag EndViewBehavior
1143End Class
1144#tag EndClass
Note: See TracBrowser for help on using the repository browser.