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 @ 42

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

Added logic to close and reopen the port for each read or write operation

RevLine 
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 = &h0
586                Sub resetCar()
587                  //This sends the command to reset the car back to a default configuration
588                  //Defaults are different for each car type
589                  setDefaultValues
590                 
591                  //Send the default values to the car
592                  writeCar
593                End Sub
594        #tag EndMethod
595
596        #tag Method, Flags = &h0
597                Sub saveProfile(theName as String)
598                  if theName <> "" then
599                   
600                    dim rs as RecordSet
601                    dim status as Boolean
602                   
603                    //Find a record
604                    rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'")
605                   
606                    //Make sure we got a record
607                    if rs <> nil then
608                      //delete the record before saving
609                      deleteProfile(theName)
610                    end if
611                   
612                    rs.Close
613                   
614                    status = createProfile(theName)
615                   
616                  else
617                   
618                    MsgBox "Please select a profile to modify"
619                   
620                  end if
621                End Sub
622        #tag EndMethod
623
624        #tag Method, Flags = &h0
625                Sub setCarType(value as string)
626                  //When setting car type we must reconfigure the serial port
627                  //Some car types have a different baud rate
628                 
629                  select case value
630                   
631                  case "MR-03"
632                    carType = value
633                    byte15 = chrb(&h05)
634                    byte16 = chrb(&h5A)
635                    byte17 = chrb(&h3C)
636                  case "dNaNo"
637                    carType = value
638                    byte15 = chrb(&hFF)
639                    byte16 = chrb(&h80)
640                    byte17 = chrb(&h80)
641                  case "ASF"
642                    carType = value
643                    byte15 = chrb(&hFF)
644                    byte16 = chrb(&hFF)
645                    byte17 = chrb(&hFF)
646                   
647                  else
648                    MsgBox "Error setting Car Type"
649                  end select
650                 
651                  valuesChanged()
652                End Sub
653        #tag EndMethod
654
655        #tag Method, Flags = &h0
656                Sub setDefaultValues()
657                  //Set the defaults for the bytes sent to a car
658                 
659                  select case carType
660                   
661                  case "MR-03"
662                    byte01 = chrb(&hD5)
663                    byte02 = chrb(&h5A)
664                    byte03 = chrb(&h64)
665                    byte04 = chrb(&hFF)
666                    byte05 = chrb(&h02)
667                    byte06 = chrb(&h02)
668                    byte07 = chrb(&h01)
669                    byte08 = chrb(&hFF)
670                    byte09 = chrb(&hBC)
671                    byte10 = chrb(&h44)
672                    byte11 = chrb(&h88)
673                    byte12 = chrb(&h78)
674                    byte13 = chrb(&hFF)
675                    byte14 = chrb(&h2C)
676                    byte15 = chrb(&h05)
677                    byte16 = chrb(&h5A)
678                    byte17 = chrb(&h3C)
679                    byte18 = chrb(&h87)
680                   
681                  case "dNaNo"
682                    byte01 = chrb(&hD5)
683                    byte02 = chrb(&h5A)
684                    byte03 = chrb(&hFF)
685                    byte04 = chrb(&hFF)
686                    byte05 = chrb(&h0A)
687                    byte06 = chrb(&h03)
688                    byte07 = chrb(&h01)
689                    byte08 = chrb(&h40)
690                    byte09 = chrb(&hBC)
691                    byte10 = chrb(&h44)
692                    byte11 = chrb(&h88)
693                    byte12 = chrb(&h78)
694                    byte13 = chrb(&h03)
695                    byte14 = chrb(&hFF)
696                    byte15 = chrb(&hFF)
697                    byte16 = chrb(&h80)
698                    byte17 = chrb(&h80)
699                    byte18 = chrb(&hA7)
700                   
701                  case "ASF"
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(&h78)
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(&hFF)
718                    byte17 = chrb(&hFF)
719                    byte18 = chrb(&hDD)
720                   
721                  else
722                    //default thing to do
723                    MsgBox "Error invalid car type"
724                    return
725                  end select
726                 
727                  //trigger the event definition so main program knows the values changed
728                  valuesChanged()
729                End Sub
730        #tag EndMethod
731
732        #tag Method, Flags = &h0
733                Sub writeCar()
734                  dim portstatus as boolean
735                  //Reopen the port just in case communication was interrupted previously
736                  //This will return true if the port is opened
737                  portstatus = reOpenPort
738                 
739                  if portstatus = true then
740                   
741                    //Send set bytes to the car
742                    mode = "write"
743                   
744                    dim sendstring as string
745                   
746                    calculateChecksum()
747                   
748                    sendstring = byte01 + byte02 + byte03 + byte04 + byte05 + byte06 + byte07 + byte08 + byte09 + byte10 + byte11 + byte12 + byte13 + byte14 + byte15 + byte16 + byte17 + byte18
749                   
750                    me.Write(sendstring)
751                   
752                  end if
753                End Sub
754        #tag EndMethod
755
756        #tag Method, Flags = &h21
757                Private Function reOpenPort() As Boolean
758                  dim status as boolean
759                  //Set the return code to false unless the port successfully opens
760                  status = false
761                 
762                  //First close the port just in case
763                  me.Close
764                 
765                  if not me.Open then
766                    //Could not open
767                    MsgBox "Error opening defined com port"
768                  else
769                    status = true
770                  end if
771                End Function
772        #tag EndMethod
773
774
775        #tag Hook, Flags = &h0
776                Event profileImported(profileName as string)
777        #tag EndHook
778
779        #tag Hook, Flags = &h0
780                Event valuesChanged()
781        #tag EndHook
782
783
784        #tag Note, Name = General
785                Car type must be set for this to operate
786                Car types supported by this application are
787                MR-03
788                dNaNo
789                ASF
790        #tag EndNote
791
792        #tag Note, Name = License
793                Copyright 2010 Jeremy Auten
794               
795                This file is part of Flip Side ICS Software.
796               
797                Flip Side ICS Software is free software: you can redistribute it and/or modify
798                it under the terms of the GNU General Public License as published by
799                the Free Software Foundation, either version 3 of the License, or
800                (at your option) any later version.
801               
802                Flip Side ICS Software is distributed in the hope that it will be useful,
803                but WITHOUT ANY WARRANTY; without even the implied warranty of
804                MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
805                GNU General Public License for more details.
806               
807                You should have received a copy of the GNU General Public License
808                along with Flip Side ICS Software.  If not, see <http://www.gnu.org/licenses/>.
809        #tag EndNote
810
811
812        #tag Property, Flags = &h21
813                Private buffer As String
814        #tag EndProperty
815
816        #tag Property, Flags = &h0
817                byte01 As String
818        #tag EndProperty
819
820        #tag Property, Flags = &h0
821                byte02 As String
822        #tag EndProperty
823
824        #tag Property, Flags = &h0
825                byte03 As String
826        #tag EndProperty
827
828        #tag Property, Flags = &h0
829                byte04 As String
830        #tag EndProperty
831
832        #tag Property, Flags = &h0
833                byte05 As String
834        #tag EndProperty
835
836        #tag Property, Flags = &h0
837                byte06 As String
838        #tag EndProperty
839
840        #tag Property, Flags = &h0
841                byte07 As String
842        #tag EndProperty
843
844        #tag Property, Flags = &h0
845                byte08 As String
846        #tag EndProperty
847
848        #tag Property, Flags = &h0
849                byte09 As String
850        #tag EndProperty
851
852        #tag Property, Flags = &h0
853                byte10 As String
854        #tag EndProperty
855
856        #tag Property, Flags = &h0
857                byte11 As String
858        #tag EndProperty
859
860        #tag Property, Flags = &h0
861                byte12 As String
862        #tag EndProperty
863
864        #tag Property, Flags = &h0
865                byte13 As String
866        #tag EndProperty
867
868        #tag Property, Flags = &h0
869                byte14 As String
870        #tag EndProperty
871
872        #tag Property, Flags = &h0
873                byte15 As String
874        #tag EndProperty
875
876        #tag Property, Flags = &h0
877                byte16 As String
878        #tag EndProperty
879
880        #tag Property, Flags = &h0
881                byte17 As String
882        #tag EndProperty
883
884        #tag Property, Flags = &h0
885                byte18 As String
886        #tag EndProperty
887
888        #tag Property, Flags = &h0
889                carType As String = "MR-03"
890        #tag EndProperty
891
892        #tag Property, Flags = &h0
893                fsicsdb As REALSQLDatabase
894        #tag EndProperty
895
896        #tag Property, Flags = &h21
897                Private mode As String = "none"
898        #tag EndProperty
899
900
901        #tag ViewBehavior
902                #tag ViewProperty
903                        Name="Baud"
904                        Visible=true
905                        Group="Behavior"
906                        InitialValue="13"
907                        Type="Integer"
908                        EditorType="Enum"
909                        InheritedFrom="serial"
910                        #tag EnumValues
911                                "0 - 300"
912                                "1 - 600"
913                                "2 - 1200"
914                                "3 - 1800"
915                                "4 - 2400"
916                                "5 - 3600"
917                                "6 - 4800"
918                                "7 - 7200"
919                                "8 - 9600"
920                                "9 - 14400"
921                                "10 - 19200"
922                                "11 - 28800"
923                                "12 - 38400"
924                                "13 - 57600"
925                                "14 - 115200"
926                                "15 - 230400"
927                        #tag EndEnumValues
928                #tag EndViewProperty
929                #tag ViewProperty
930                        Name="Bits"
931                        Visible=true
932                        Group="Behavior"
933                        InitialValue="3"
934                        Type="Integer"
935                        EditorType="Enum"
936                        InheritedFrom="serial"
937                        #tag EnumValues
938                                "0 - 5 Data Bits"
939                                "1 - 6 Data Bits"
940                                "2 - 7 Data Bits"
941                                "3 - 8 Data bits"
942                        #tag EndEnumValues
943                #tag EndViewProperty
944                #tag ViewProperty
945                        Name="byte01"
946                        Group="Behavior"
947                        InitialValue="&hFF"
948                        Type="String"
949                        EditorType="MultiLineEditor"
950                #tag EndViewProperty
951                #tag ViewProperty
952                        Name="byte02"
953                        Group="Behavior"
954                        Type="String"
955                        EditorType="MultiLineEditor"
956                #tag EndViewProperty
957                #tag ViewProperty
958                        Name="byte03"
959                        Group="Behavior"
960                        Type="String"
961                        EditorType="MultiLineEditor"
962                #tag EndViewProperty
963                #tag ViewProperty
964                        Name="byte04"
965                        Group="Behavior"
966                        Type="String"
967                        EditorType="MultiLineEditor"
968                #tag EndViewProperty
969                #tag ViewProperty
970                        Name="byte05"
971                        Group="Behavior"
972                        Type="String"
973                        EditorType="MultiLineEditor"
974                #tag EndViewProperty
975                #tag ViewProperty
976                        Name="byte06"
977                        Group="Behavior"
978                        Type="String"
979                        EditorType="MultiLineEditor"
980                #tag EndViewProperty
981                #tag ViewProperty
982                        Name="byte07"
983                        Group="Behavior"
984                        Type="String"
985                        EditorType="MultiLineEditor"
986                #tag EndViewProperty
987                #tag ViewProperty
988                        Name="byte08"
989                        Group="Behavior"
990                        Type="String"
991                        EditorType="MultiLineEditor"
992                #tag EndViewProperty
993                #tag ViewProperty
994                        Name="byte09"
995                        Group="Behavior"
996                        Type="String"
997                        EditorType="MultiLineEditor"
998                #tag EndViewProperty
999                #tag ViewProperty
1000                        Name="byte10"
1001                        Group="Behavior"
1002                        Type="String"
1003                        EditorType="MultiLineEditor"
1004                #tag EndViewProperty
1005                #tag ViewProperty
1006                        Name="byte11"
1007                        Group="Behavior"
1008                        Type="String"
1009                        EditorType="MultiLineEditor"
1010                #tag EndViewProperty
1011                #tag ViewProperty
1012                        Name="byte12"
1013                        Group="Behavior"
1014                        Type="String"
1015                        EditorType="MultiLineEditor"
1016                #tag EndViewProperty
1017                #tag ViewProperty
1018                        Name="byte13"
1019                        Group="Behavior"
1020                        Type="String"
1021                        EditorType="MultiLineEditor"
1022                #tag EndViewProperty
1023                #tag ViewProperty
1024                        Name="byte14"
1025                        Group="Behavior"
1026                        Type="String"
1027                        EditorType="MultiLineEditor"
1028                #tag EndViewProperty
1029                #tag ViewProperty
1030                        Name="byte15"
1031                        Group="Behavior"
1032                        Type="String"
1033                        EditorType="MultiLineEditor"
1034                #tag EndViewProperty
1035                #tag ViewProperty
1036                        Name="byte16"
1037                        Group="Behavior"
1038                        Type="String"
1039                        EditorType="MultiLineEditor"
1040                #tag EndViewProperty
1041                #tag ViewProperty
1042                        Name="byte17"
1043                        Group="Behavior"
1044                        Type="String"
1045                        EditorType="MultiLineEditor"
1046                #tag EndViewProperty
1047                #tag ViewProperty
1048                        Name="byte18"
1049                        Group="Behavior"
1050                        Type="String"
1051                        EditorType="MultiLineEditor"
1052                #tag EndViewProperty
1053                #tag ViewProperty
1054                        Name="carType"
1055                        Group="Behavior"
1056                        InitialValue="MR-03"
1057                        Type="String"
1058                        EditorType="MultiLineEditor"
1059                #tag EndViewProperty
1060                #tag ViewProperty
1061                        Name="CTS"
1062                        Visible=true
1063                        Group="Behavior"
1064                        Type="Boolean"
1065                        InheritedFrom="serial"
1066                #tag EndViewProperty
1067                #tag ViewProperty
1068                        Name="DTR"
1069                        Visible=true
1070                        Group="Behavior"
1071                        Type="Boolean"
1072                        InheritedFrom="serial"
1073                #tag EndViewProperty
1074                #tag ViewProperty
1075                        Name="Index"
1076                        Visible=true
1077                        Group="ID"
1078                        Type="Integer"
1079                        InheritedFrom="serial"
1080                #tag EndViewProperty
1081                #tag ViewProperty
1082                        Name="Left"
1083                        Visible=true
1084                        Group="Position"
1085                        InheritedFrom="serial"
1086                #tag EndViewProperty
1087                #tag ViewProperty
1088                        Name="Name"
1089                        Visible=true
1090                        Group="ID"
1091                        InheritedFrom="serial"
1092                #tag EndViewProperty
1093                #tag ViewProperty
1094                        Name="Parity"
1095                        Visible=true
1096                        Group="Behavior"
1097                        InitialValue="0"
1098                        Type="Integer"
1099                        EditorType="Enum"
1100                        InheritedFrom="serial"
1101                        #tag EnumValues
1102                                "0 - No Parity"
1103                                "1 - Odd Parity"
1104                                "2 - EvenParity"
1105                        #tag EndEnumValues
1106                #tag EndViewProperty
1107                #tag ViewProperty
1108                        Name="Stop"
1109                        Visible=true
1110                        Group="Behavior"
1111                        InitialValue="0"
1112                        Type="Integer"
1113                        EditorType="Enum"
1114                        InheritedFrom="serial"
1115                        #tag EnumValues
1116                                "0 - 1 Stop Bit"
1117                                "1 - 1.5 Stop Bits"
1118                                "2 - 2 Stop Bits"
1119                        #tag EndEnumValues
1120                #tag EndViewProperty
1121                #tag ViewProperty
1122                        Name="Super"
1123                        Visible=true
1124                        Group="ID"
1125                        InheritedFrom="serial"
1126                #tag EndViewProperty
1127                #tag ViewProperty
1128                        Name="Top"
1129                        Visible=true
1130                        Group="Position"
1131                        InheritedFrom="serial"
1132                #tag EndViewProperty
1133                #tag ViewProperty
1134                        Name="XON"
1135                        Visible=true
1136                        Group="Behavior"
1137                        Type="Boolean"
1138                        InheritedFrom="serial"
1139                #tag EndViewProperty
1140        #tag EndViewBehavior
1141End Class
1142#tag EndClass
Note: See TracBrowser for help on using the repository browser.