Changeset 26 for trunk/desktop/ICSSerialPort.rbbas
- Timestamp:
- 04/09/10 09:52:39 (15 years ago)
- File:
-
- 1 edited
-
trunk/desktop/ICSSerialPort.rbbas (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
trunk/desktop/ICSSerialPort.rbbas
r25 r26 455 455 #tag EndMethod 456 456 457 #tag Method, Flags = &h0 458 Sub exportProfile(theName as string) 459 dim xml as XmlDocument 460 dim root as XmlNode 461 dim rootchild as XmlNode 462 dim rs as RecordSet 463 dim i as integer 464 dim dlg as SaveAsDialog 465 dim f as FolderItem 466 467 dlg = New SaveAsDialog 468 dlg.Title = "Export your profile" 469 #if TargetLinux 470 dlg.InitialDirectory = SpecialFolder.Home 471 #else 472 dlg.InitialDirectory = SpecialFolder.Documents 473 #endif 474 475 dlg.SuggestedFileName = "ics_"+theName+".xml" 476 f = dlg.ShowModal() 477 478 if f <> Nil then 479 //Nothing to see here, move along 480 else 481 MsgBox "You must choose a file" 482 Return 483 end if 484 485 //Find the record 486 rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'") 487 488 if rs <> Nil then 489 //We have a record, so do something 490 491 //Create the root element of the XML file 492 xml = New XmlDocument 493 root = xml.AppendChild(xml.CreateElement("icsprofile")) 494 495 //Itterate all available fields and write them to the xml document 496 for i = 1 to rs.FieldCount 497 if rs.IdxField(i).Name <> "" and rs.IdxField(i).StringValue<> "" then 498 499 rootchild = root.AppendChild(xml.CreateElement(rs.IdxField(i).Name)) 500 rootchild.AppendChild(xml.CreateTextNode(rs.IdxField(i).StringValue)) 501 end if 502 next 503 504 //Write the document to a file 505 xml.SaveXml(f) 506 else 507 MsgBox "No profile to export" 508 Return 509 end if 510 511 End Sub 512 #tag EndMethod 513 514 #tag Method, Flags = &h0 515 Function importProfile() As Boolean 516 dim success as boolean 517 dim dlg as OpenDialog 518 dim f as FolderItem 519 dim xdoc as XmlDocument 520 dim root as XmlNode 521 dim i as integer 522 dim count as Integer 523 dim item as string 524 dim rec as DatabaseRecord 525 dim theName as string 526 527 rec = New DatabaseRecord 528 success = False 529 530 531 //Get the user to select a file 532 dlg = New OpenDialog 533 dlg.Title = "Select a profile to import" 534 #if TargetLinux 535 dlg.InitialDirectory = SpecialFolder.Home 536 #else 537 dlg.InitialDirectory = SpecialFolder.Documents 538 #endif 539 f = dlg.ShowModal() 540 541 //If we have a valid file we need to read it as an xml file to process it 542 //Items are individually specified to prevent the program from trying to insert columns that do not exist 543 //All column names should match the database table 544 545 if f <> nil then 546 547 //Read the XML file 548 xdoc = New XmlDocument(f) 549 550 count = xdoc.DocumentElement.ChildCount 551 552 for i = 0 to count - 1 553 root = xdoc.DocumentElement.Child(i) 554 555 item = root.FirstChild.Value 556 557 select case root.Name 558 559 case "name" 560 theName = item 561 case "cartype" 562 carType = item 563 case "byte01" 564 byte01 = chrb(val(item)) 565 case "byte02" 566 byte02 = chrb(val(item)) 567 case "byte03" 568 byte03 = chrb(val(item)) 569 case "byte04" 570 byte04 = chrb(val(item)) 571 case "byte05" 572 byte05 = chrb(val(item)) 573 case "byte06" 574 byte06 = chrb(val(item)) 575 case "byte07" 576 byte07 = chrb(val(item)) 577 case "byte08" 578 byte08 = chrb(val(item)) 579 case "byte09" 580 byte09 = chrb(val(item)) 581 case "byte10" 582 byte10 = chrb(val(item)) 583 case "byte11" 584 byte11 = chrb(val(item)) 585 case "byte12" 586 byte12 = chrb(val(item)) 587 case "byte13" 588 byte13 = chrb(val(item)) 589 case "byte14" 590 byte14 = chrb(val(item)) 591 case "byte15" 592 byte15 = chrb(val(item)) 593 case "byte16" 594 byte16 = chrb(val(item)) 595 case "byte17" 596 byte17 = chrb(val(item)) 597 case "byte18" 598 byte18 = chrb(val(item)) 599 600 end select 601 602 next 603 604 else 605 //File not select we can stop 606 success = False 607 return success 608 end if 609 610 //Now check to make sure their is not an existing profile with this name 611 dim rs as RecordSet 612 613 rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name= '"+theName+"'") 614 615 if rs <> Nil then 616 617 if rs.RecordCount > 0 then 618 //we have a duplicate record 619 //we need to prompt the user about what to do 620 dim d as New MessageDialog 621 dim b as MessageDialogButton 622 d.Icon = MessageDialog.GraphicCaution 623 d.ActionButton.Caption = "Yes" 624 d.CancelButton.Visible = True 625 d.CancelButton.Caption = "No" 626 d.Message = "A profile exists with this name, do you want to overwrite the existing profile?" 627 b = d.ShowModal 628 629 //Now determine what the user chose 630 Select Case b 631 case d.ActionButton 632 //The user wants to overwrite the record so we can just save what we have 633 saveProfile(theName) 634 success = True 635 //Values changed because of the overwrite 636 valuesChanged() 637 case d.CancelButton 638 //The user chose not to overwrite the record, we need to come up with a new name 639 //We will increment the number until we find a name not used or we hit 32 just in case an infinite loop would occur 640 dim tempString as string 641 dim tempName as string 642 i = 0 643 while rs.RecordCount > 0 644 i = i + 1 645 tempString = str(i) 646 tempName = theName + tempString 647 //Check to make sure we are not in an infinite looooooooop 648 //If we are something went wrong 649 if i > 31 then 650 exit While 651 end if 652 rs = fsicsdb.SQLSelect("SELECT * FROM carprofiles WHERE name = '"+tempName+"'") 653 654 wend 655 //OK we have a unique name at this point 656 theName = theName + tempString 657 saveProfile(theName) 658 success = True 659 //new profile was imported 660 profileImported(theName) 661 end select 662 663 else 664 //No duplicate exists so we can just insert the record 665 saveProfile(theName) 666 success = True 667 //new profile was imported 668 profileImported(theName) 669 end if 670 //Close our record 671 rs.Close 672 673 end if 674 675 Return success 676 677 End Function 678 #tag EndMethod 679 457 680 458 681 #tag Hook, Flags = &h0 459 682 Event valuesChanged() 683 #tag EndHook 684 685 #tag Hook, Flags = &h0 686 Event profileImported(profileName as string) 460 687 #tag EndHook 461 688
Note: See TracChangeset
for help on using the changeset viewer.