diff --git a/Host/MicroBoot.exe b/Host/MicroBoot.exe index 1a221632..a59e991d 100644 Binary files a/Host/MicroBoot.exe and b/Host/MicroBoot.exe differ diff --git a/Host/PCANBasic.dll b/Host/PCANBasic.dll new file mode 100644 index 00000000..4836d8a8 Binary files /dev/null and b/Host/PCANBasic.dll differ diff --git a/Host/Pcan_usb.dll b/Host/Pcan_usb.dll deleted file mode 100644 index cfd024d5..00000000 Binary files a/Host/Pcan_usb.dll and /dev/null differ diff --git a/Host/Source/MicroBoot/MainUnit.dfm b/Host/Source/MicroBoot/MainUnit.dfm index 488be260..3534005d 100644 Binary files a/Host/Source/MicroBoot/MainUnit.dfm and b/Host/Source/MicroBoot/MainUnit.dfm differ diff --git a/Host/Source/MicroBoot/MainUnit.pas b/Host/Source/MicroBoot/MainUnit.pas index 23447f4c..24f49976 100644 --- a/Host/Source/MicroBoot/MainUnit.pas +++ b/Host/Source/MicroBoot/MainUnit.pas @@ -141,6 +141,8 @@ end; //*** end of OnMbiStarted *** procedure TmainForm.OnMbiProgress(progress: Longword); begin prgDownload.Position := progress; // update the progress bar + prgDownload.Position := progress-1; // fix for progress bar not going to 100% + prgDownload.Position := progress; // update the progress bar end; //*** end of OnMbiProgress *** @@ -178,7 +180,7 @@ end; //*** end of OnMbiDone *** //*************************************************************************************** procedure TmainForm.OnMbiError(error: ShortString); begin - ShowMessage(error); // display error + ShowMessage(String(error)); // display error Timer.Enabled := false; // stop the timer StopWatch.Stop; // stop the stopwatch mainForm.Caption := FormCaption; // restore caption @@ -205,7 +207,7 @@ procedure TmainForm.OnMbiLog(info: ShortString); begin if MbiLogging = True then begin - LogLines.Add(info); // add to log + LogLines.Add(String(info)); // add to log end; end; //*** end of OnMbiLog *** @@ -221,7 +223,7 @@ end; //*** end of OnMbiLog *** procedure TmainForm.OnMbiInfo(info: ShortString); begin if NtbPages.PageIndex = 1 then - lblDownloadProgress.Caption := info; + lblDownloadProgress.Caption := String(info); end; //*** end of OnMbiLog *** @@ -235,8 +237,8 @@ end; //*** end of OnMbiLog *** //*************************************************************************************** function TmainForm.GetActiveMbi : string; begin - if IsMbiInterface(MbiLibFile) then - Result := MbiLibFile + if IsMbiInterface(String(MbiLibFile)) then + Result := String(MbiLibFile) else Result := ''; end; //*** end of GetActiveMbi *** @@ -255,7 +257,7 @@ begin if IsMbiInterface(libFile) then begin - MbiLibFile := libFile; + MbiLibFile := ShortString(libFile); MbiInterfaced := MbiInterface.Enable(libFile, OnMbiStarted, OnMbiProgress, OnMbiDone, OnMbiError, OnMbiLog, OnMbiInfo); end; @@ -315,7 +317,8 @@ begin end; end; Result := LibValid; -end; //*** end of IsMbiInterface *** +end; +//*** end of IsMbiInterface *** //*************************************************************************************** @@ -348,7 +351,7 @@ begin if Assigned(DescriptionFnc) then begin - Result := Result + DescriptionFnc; + Result := Result + String(DescriptionFnc); end; if Assigned(VersionFnc) then @@ -406,11 +409,11 @@ end; //*** end of GetInterfaceFileList *** //*************************************************************************************** procedure TmainForm.StartFileDownload(fileName : ShortString); begin - if FileExists(fileName) and (MbiInterfaced = True) then + if FileExists(String(fileName)) and (MbiInterfaced = True) then begin FormCaption := mainForm.Caption; // backup original caption mainForm.Caption := FormCaption + ' - Downloading ' + - ExtractFileName(fileName) + '...'; + ExtractFileName(String(fileName)) + '...'; prgDownload.Position := 0; // reset the progress bar NtbPages.PageIndex := 1; // go to the next page btnSettings.Enabled := false; // settings can't be changed anymore @@ -432,7 +435,7 @@ begin // display interface library description if MbiInterfaced = True then begin - lblInterfaceName.Caption := 'for ' + MbiInterface.Description; + lblInterfaceName.Caption := 'for ' + String(MbiInterface.Description); end else begin @@ -538,7 +541,7 @@ begin // is it a valid Mbi interface library? if IsMbiInterface(foundLibrary) = True then begin - MbiLibFile := foundLibrary; + MbiLibFile := ShortString(foundLibrary); foundInterface := True; end; end; @@ -560,7 +563,7 @@ begin // is it a valid Mbi interface library? if IsMbiInterface(foundLibrary) = True then begin - MbiLibFile := foundLibrary; + MbiLibFile := ShortString(foundLibrary); foundInterface := True; end; end; @@ -579,7 +582,7 @@ begin // is it a valid Mbi interface library? if IsMbiInterface(foundLibrary) = True then begin - MbiLibFile := foundLibrary; + MbiLibFile := ShortString(foundLibrary); foundInterface := True; end; end; @@ -589,7 +592,7 @@ begin // did we find a Mbi interface library? if foundInterface = True then begin - SetActiveMbi(MbiLibFile); + SetActiveMbi(String(MbiLibFile)); end; // create the stopwatch timer @@ -634,7 +637,7 @@ begin if (ParamCount > 0) and (FileExists(ParamStr(ParamCount))) then begin edtDownloadFile.Text := ParamStr(ParamCount); - StartFileDownload(ParamStr(ParamCount)); + StartFileDownload(ShortString(ParamStr(ParamCount))); Exit; // nothing more todo end; @@ -653,7 +656,7 @@ begin if FileExists(OpenDialog.FileName) then begin edtDownloadFile.Text := OpenDialog.FileName; - StartFileDownload(OpenDialog.FileName); + StartFileDownload(ShortString(OpenDialog.FileName)); end; end; end; @@ -676,7 +679,7 @@ begin if FileExists(OpenDialog.FileName) then begin edtDownloadFile.Text := OpenDialog.FileName; - StartFileDownload(OpenDialog.FileName); + StartFileDownload(ShortString(OpenDialog.FileName)); end; end; end; //*** end of btnBrowseClick *** @@ -702,7 +705,7 @@ begin winRegistry := TRegistry.Create; winRegistry.RootKey := HKEY_CURRENT_USER; winRegistry.OpenKey('Software\Feaser\MicroBoot', true); - winRegistry.WriteString('Interface', ExtractFileName(MbiLibFile)); + winRegistry.WriteString('Interface', ExtractFileName(String(MbiLibFile))); winRegistry.Free; end; UpdateInterfaceLabel; @@ -751,7 +754,7 @@ begin // start the download if FileExists(edtDownloadFile.Text) then begin - StartFileDownload(edtDownloadFile.Text); + StartFileDownload(ShortString(edtDownloadFile.Text)); end; end; diff --git a/Host/Source/MicroBoot/MicroBoot.cfg b/Host/Source/MicroBoot/MicroBoot.cfg deleted file mode 100644 index d9e521de..00000000 --- a/Host/Source/MicroBoot/MicroBoot.cfg +++ /dev/null @@ -1,35 +0,0 @@ --$A+ --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I+ --$J+ --$K- --$L+ --$M- --$N+ --$O+ --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E../../ --LNc:\borland\delphi4\Lib diff --git a/Host/Source/MicroBoot/MicroBoot.dof b/Host/Source/MicroBoot/MicroBoot.dof deleted file mode 100644 index ff39552a..00000000 --- a/Host/Source/MicroBoot/MicroBoot.dof +++ /dev/null @@ -1,89 +0,0 @@ -[Compiler] -A=1 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=1 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=../../ -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40 -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1031 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[Excluded Packages] -$(DELPHI)\Lib\dclusr40.bpl=Borland User -$(DELPHI)\Components\tsock\tsock.bpl=(untitled) -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlOutputDirectorry] -Count=3 -Item0=../../ -Item1=../.. -Item2=../ diff --git a/Host/Source/MicroBoot/MicroBoot.dpr b/Host/Source/MicroBoot/MicroBoot.dpr index 3245830b..e5242bf6 100644 --- a/Host/Source/MicroBoot/MicroBoot.dpr +++ b/Host/Source/MicroBoot/MicroBoot.dpr @@ -35,7 +35,8 @@ uses Forms, MainUnit in 'MainUnit.pas' {mainForm}, SettingsUnit in 'SettingsUnit.pas' {settingsForm}, - StopWatch in 'StopWatch.pas'; + StopWatch in 'StopWatch.pas', + uBootInterface in 'uBootInterface.pas'; {$R *.RES} diff --git a/Host/Source/MicroBoot/MicroBoot.dproj b/Host/Source/MicroBoot/MicroBoot.dproj new file mode 100644 index 00000000..50f8e317 --- /dev/null +++ b/Host/Source/MicroBoot/MicroBoot.dproj @@ -0,0 +1,136 @@ + + + {DF84500F-F9C3-464D-AB96-10E57464FFB5} + MicroBoot.dpr + True + Debug + 1 + Application + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_1 + true + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + false + 1 + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win;$(DCC_Namespace) + 00400000 + MicroBoot + 1 + true + false + ../../ + 1 + true + 1031 + Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage) + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + + + $(BDS)\bin\default_app.manifest + Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + true + 1033 + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + 1033 + MicroBoot.ico + true + true + true + + + DEBUG;$(DCC_Define) + false + true + + + 2 + CompanyName=Feaser;FileDescription=PC download tool for the OpenBLT bootloader;FileVersion=1.2.0.0;InternalName=;LegalCopyright=Feaser;LegalTrademarks=;OriginalFilename=;ProductName=MicroBoot;ProductVersion=1.2.0.0;Comments= + true + true + 1033 + true + MicroBoot.ico + + + + MainSource + + +
mainForm
+ + +
settingsForm
+ + + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + MicroBoot.dpr + + + + True + + + 12 + + + + diff --git a/Host/Source/MicroBoot/interfaces/XcpIcon.bmp b/Host/Source/MicroBoot/interfaces/XcpIcon.bmp deleted file mode 100644 index c7923878..00000000 Binary files a/Host/Source/MicroBoot/interfaces/XcpIcon.bmp and /dev/null differ diff --git a/Host/Source/MicroBoot/interfaces/XcpIcon.png b/Host/Source/MicroBoot/interfaces/XcpIcon.png new file mode 100644 index 00000000..6c0e1944 Binary files /dev/null and b/Host/Source/MicroBoot/interfaces/XcpIcon.png differ diff --git a/Host/Source/MicroBoot/interfaces/XcpLoader.pas b/Host/Source/MicroBoot/interfaces/XcpLoader.pas index 7a89ae2b..c250f3f8 100644 --- a/Host/Source/MicroBoot/interfaces/XcpLoader.pas +++ b/Host/Source/MicroBoot/interfaces/XcpLoader.pas @@ -453,6 +453,10 @@ begin // init return value Result := false; + // validate packet length. it must always be > 0 + if comDriver.packetLen = 0 then + Exit; + // make a copy of the packet data because the synch command could overwrite it SetLength(dataCpy, comDriver.packetLen); for cnt := 0 to comDriver.packetLen-1 do @@ -1256,6 +1260,10 @@ begin // init return value result := false; + // validate FCtoPGMPacketLen because using it to prevent possible divide by 0 + if FCtoPGMPacketLen = 0 then + exit; + // set the start address for the program operation if not CmdSetMta(addr) then Exit; diff --git a/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.bmp b/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.bmp deleted file mode 100644 index 6ca58cdf..00000000 Binary files a/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.bmp and /dev/null differ diff --git a/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png b/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png new file mode 100644 index 00000000..ed2db00d Binary files /dev/null and b/Host/Source/MicroBoot/interfaces/can/peak/CANIcon.png differ diff --git a/Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas b/Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas new file mode 100644 index 00000000..c0257a96 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/peak/PCANBasic.pas @@ -0,0 +1,557 @@ +// PCANBasic.pas +// +// ~~~~~~~~~~~~ +// +// PCAN-Basic API +// +// ~~~~~~~~~~~~ +// +// ------------------------------------------------------------------ +// Author : Keneth Wagner +// Last change: 18.05.2016 Wagner +// +// Language: Pascal +// ------------------------------------------------------------------ +// +// Copyright (C) 1999-2016 PEAK-System Technik GmbH, Darmstadt +// more Info at http://www.peak-system.com +// +unit PCANBasic; + +interface + +const + //////////////////////////////////////////////////////////// + // Value definitions + //////////////////////////////////////////////////////////// + + // Currently defined and supported PCAN channels + // + PCAN_NONEBUS = $00; // Undefined/default value for a PCAN bus + + PCAN_ISABUS1 = $21; // PCAN-ISA interface, channel 1 + PCAN_ISABUS2 = $22; // PCAN-ISA interface, channel 2 + PCAN_ISABUS3 = $23; // PCAN-ISA interface, channel 3 + PCAN_ISABUS4 = $24; // PCAN-ISA interface, channel 4 + PCAN_ISABUS5 = $25; // PCAN-ISA interface, channel 5 + PCAN_ISABUS6 = $26; // PCAN-ISA interface, channel 6 + PCAN_ISABUS7 = $27; // PCAN-ISA interface, channel 7 + PCAN_ISABUS8 = $28; // PCAN-ISA interface, channel 8 + + PCAN_DNGBUS1 = $31; // PPCAN-Dongle/LPT interface, channel 1 + + PCAN_PCIBUS1 = $41; // PCAN-PCI interface, channel 1 + PCAN_PCIBUS2 = $42; // PCAN-PCI interface, channel 2 + PCAN_PCIBUS3 = $43; // PCAN-PCI interface, channel 3 + PCAN_PCIBUS4 = $44; // PCAN-PCI interface, channel 4 + PCAN_PCIBUS5 = $45; // PCAN-PCI interface, channel 5 + PCAN_PCIBUS6 = $46; // PCAN-PCI interface, channel 6 + PCAN_PCIBUS7 = $47; // PCAN-PCI interface, channel 7 + PCAN_PCIBUS8 = $48; // PCAN-PCI interface, channel 8 + PCAN_PCIBUS9 = $409; // PCAN-PCI interface, channel 9 + PCAN_PCIBUS10 = $40A; // PCAN-PCI interface, channel 10 + PCAN_PCIBUS11 = $40B; // PCAN-PCI interface, channel 11 + PCAN_PCIBUS12 = $40C; // PCAN-PCI interface, channel 12 + PCAN_PCIBUS13 = $40D; // PCAN-PCI interface, channel 13 + PCAN_PCIBUS14 = $40E; // PCAN-PCI interface, channel 14 + PCAN_PCIBUS15 = $40F; // PCAN-PCI interface, channel 15 + PCAN_PCIBUS16 = $410; // PCAN-PCI interface, channel 16 + + PCAN_USBBUS1 = $51; // PCAN-USB interface, channel 1 + PCAN_USBBUS2 = $52; // PCAN-USB interface, channel 2 + PCAN_USBBUS3 = $53; // PCAN-USB interface, channel 3 + PCAN_USBBUS4 = $54; // PCAN-USB interface, channel 4 + PCAN_USBBUS5 = $55; // PCAN-USB interface, channel 5 + PCAN_USBBUS6 = $56; // PCAN-USB interface, channel 6 + PCAN_USBBUS7 = $57; // PCAN-USB interface, channel 7 + PCAN_USBBUS8 = $58; // PCAN-USB interface, channel 8 + PCAN_USBBUS9 = $509; // PCAN-USB interface, channel 9 + PCAN_USBBUS10 = $50A; // PCAN-USB interface, channel 10 + PCAN_USBBUS11 = $50B; // PCAN-USB interface, channel 11 + PCAN_USBBUS12 = $50C; // PCAN-USB interface, channel 12 + PCAN_USBBUS13 = $50D; // PCAN-USB interface, channel 13 + PCAN_USBBUS14 = $50E; // PCAN-USB interface, channel 14 + PCAN_USBBUS15 = $50F; // PCAN-USB interface, channel 15 + PCAN_USBBUS16 = $510; // PCAN-USB interface, channel 16 + + PCAN_PCCBUS1 = $61; // PCAN-PC Card interface, channel 1 + PCAN_PCCBUS2 = $62; // PCAN-PC Card interface, channel 2 + + PCAN_LANBUS1 = $801; // PCAN-LAN interface, channel 1 + PCAN_LANBUS2 = $802; // PCAN-LAN interface, channel 2 + PCAN_LANBUS3 = $803; // PCAN-LAN interface, channel 3 + PCAN_LANBUS4 = $804; // PCAN-LAN interface, channel 4 + PCAN_LANBUS5 = $805; // PCAN-LAN interface, channel 5 + PCAN_LANBUS6 = $806; // PCAN-LAN interface, channel 6 + PCAN_LANBUS7 = $807; // PCAN-LAN interface, channel 7 + PCAN_LANBUS8 = $808; // PCAN-LAN interface, channel 8 + PCAN_LANBUS9 = $809; // PCAN-LAN interface, channel 9 + PCAN_LANBUS10 = $80A; // PCAN-LAN interface, channel 10 + PCAN_LANBUS11 = $80B; // PCAN-LAN interface, channel 11 + PCAN_LANBUS12 = $80C; // PCAN-LAN interface, channel 12 + PCAN_LANBUS13 = $80D; // PCAN-LAN interface, channel 13 + PCAN_LANBUS14 = $80E; // PCAN-LAN interface, channel 14 + PCAN_LANBUS15 = $80F; // PCAN-LAN interface, channel 15 + PCAN_LANBUS16 = $810; // PCAN-LAN interface, channel 16 + + // Represent the PCAN error and status codes + // + PCAN_ERROR_OK = $00000; // No error + PCAN_ERROR_XMTFULL = $00001; // Transmit buffer in CAN controller is full + PCAN_ERROR_OVERRUN = $00002; // CAN controller was read too late + PCAN_ERROR_BUSLIGHT = $00004; // Bus error: an error counter reached the 'light' limit [Not used with the *FD functions] + PCAN_ERROR_BUSHEAVY = $00008; // Bus error: an error counter reached the 'heavy' limit + PCAN_ERROR_BUSWARNING = PCAN_ERROR_BUSHEAVY; // An error counter reached the 'warning' limit [ONLY used with the *FD functions] + PCAN_ERROR_BUSPASSIVE = $40000; // Bus error: the CAN controller is in bus-off state + PCAN_ERROR_BUSOFF = $00010; // Bus error: the CAN controller is in bus-off state + PCAN_ERROR_ANYBUSERR = PCAN_ERROR_BUSWARNING Or PCAN_ERROR_BUSLIGHT Or PCAN_ERROR_BUSHEAVY Or PCAN_ERROR_BUSOFF Or PCAN_ERROR_BUSPASSIVE; // Mask for all bus errors + PCAN_ERROR_QRCVEMPTY = $00020; // Receive queue is empty + PCAN_ERROR_QOVERRUN = $00040; // Receive queue was read too late + PCAN_ERROR_QXMTFULL = $00080; // Transmit queue is full + PCAN_ERROR_REGTEST = $00100; // Test of the CAN controller hardware registers failed (no hardware found) + PCAN_ERROR_NODRIVER = $00200; // Driver not loaded + PCAN_ERROR_HWINUSE = $00400; // Hardware already in use by a Net + PCAN_ERROR_NETINUSE = $00800; // A Client is already connected to the Net + PCAN_ERROR_ILLHW = $01400; // Hardware handle is invalid + PCAN_ERROR_ILLNET = $01800; // Net handle is invalid + PCAN_ERROR_ILLCLIENT = $01C00; // Client handle is invalid + PCAN_ERROR_ILLHANDLE = PCAN_ERROR_ILLHW Or PCAN_ERROR_ILLNET Or PCAN_ERROR_ILLCLIENT; // Mask for all handle errors + PCAN_ERROR_RESOURCE = $02000; // Resource (FIFO, Client, timeout) cannot be created + PCAN_ERROR_ILLPARAMTYPE = $04000; // Invalid parameter + PCAN_ERROR_ILLPARAMVAL = $08000; // Invalid parameter value + PCAN_ERROR_UNKNOWN = $10000; // Unknown error + PCAN_ERROR_ILLDATA = $20000; // Invalid data, function, or action + PCAN_ERROR_CAUTION = $2000000; // An operation was successfully carried out, however, irregularities were registered + PCAN_ERROR_INITIALIZE = $4000000; // Channel is not initialized [Value was changed from 0x40000 to 0x4000000] + PCAN_ERROR_ILLOPERATION = $8000000; // Invalid operation [Value was changed from 0x80000 to 0x8000000] + + // PCAN devices + // + PCAN_NONE = $00; // Undefined, unknown or not selected PCAN device value + PCAN_PEAKCAN = $01; // PCAN Non-Plug&Play devices. NOT USED WITHIN PCAN-Basic API + PCAN_ISA = $02; // PCAN-ISA, PCAN-PC/104, and PCAN-PC/104-Plus + PCAN_DNG = $03; // PCAN-Dongle + PCAN_PCI = $04; // PCAN-PCI, PCAN-cPCI, PCAN-miniPCI, and PCAN-PCI Express + PCAN_USB = $05; // PCAN-USB and PCAN-USB Pro + PCAN_PCC = $06; // PCAN-PC Card + PCAN_VIRTUAL = $07; // PCAN Virtual hardware. NOT USED WITHIN PCAN-Basic API + PCAN_LAN = $08; // PCAN Gateway devices + + // PCAN parameters + // + PCAN_DEVICE_NUMBER = $01; // PCAN-USB device number parameter + PCAN_5VOLTS_POWER = $02; // PCAN-PC Card 5-Volt power parameter + PCAN_RECEIVE_EVENT = $03; // PCAN receive event handler parameter + PCAN_MESSAGE_FILTER = $04; // PCAN message filter parameter + PCAN_API_VERSION = $05; // PCAN-Basic API version parameter + PCAN_CHANNEL_VERSION = $06; // PCAN device channel version parameter + PCAN_BUSOFF_AUTORESET = $07; // PCAN Reset-On-Busoff parameter + PCAN_LISTEN_ONLY = $08; // PCAN Listen-Only parameter + PCAN_LOG_LOCATION = $09; // Directory path for log files + PCAN_LOG_STATUS = $0A; // Debug-Log activation status + PCAN_LOG_CONFIGURE = $0B; // Configuration of the debugged information (LOG_FUNCTION_***) + PCAN_LOG_TEXT = $0C; // Custom insertion of text into the log file + PCAN_CHANNEL_CONDITION = $0D; // Availability status of a PCAN-Channel + PCAN_HARDWARE_NAME = $0E; // PCAN hardware name parameter + PCAN_RECEIVE_STATUS = $0F; // Message reception status of a PCAN-Channel + PCAN_CONTROLLER_NUMBER = $10; // CAN-Controller number of a PCAN-Channel + PCAN_TRACE_LOCATION = $11; // Directory path for PCAN trace files + PCAN_TRACE_STATUS = $12; // CAN tracing activation status + PCAN_TRACE_SIZE = $13; // Configuration of the maximum file size of a CAN trace + PCAN_TRACE_CONFIGURE = $14; // Configuration of the trace file storing mode (TRACE_FILE_***) + PCAN_CHANNEL_IDENTIFYING = $15; // Physical identification of a USB based PCAN-Channel by blinking its associated LED + PCAN_CHANNEL_FEATURES = $16; // Capabilities of a PCAN device (FEATURE_***) + PCAN_BITRATE_ADAPTING = $17; // Using of an existing bit rate (PCAN-View connected to a channel) + PCAN_BITRATE_INFO = $18; // Configured bit rate as Btr0Btr1 value + PCAN_BITRATE_INFO_FD = $19; // Configured bit rate as TPCANBitrateFD string + PCAN_BUSSPEED_NOMINAL = $1A; // Configured nominal CAN Bus speed as Bits per seconds + PCAN_BUSSPEED_DATA = $1B; // Configured CAN data speed as Bits per seconds + PCAN_IP_ADDRESS = $1C; // Remote address of a LAN channel as string in IPv4 format + PCAN_LAN_SERVICE_STATUS = $1D; // Status of the Virtual PCAN-Gateway Service + + // PCAN parameter values + // + PCAN_PARAMETER_OFF = $00; // The PCAN parameter is not set (inactive) + PCAN_PARAMETER_ON = $01; // The PCAN parameter is set (active) + PCAN_FILTER_CLOSE = $00; // The PCAN filter is closed. No messages will be received + PCAN_FILTER_OPEN = $01; // The PCAN filter is fully opened. All messages will be received + PCAN_FILTER_CUSTOM = $02; // The PCAN filter is custom configured. Only registered + PCAN_CHANNEL_UNAVAILABLE = $00; // The PCAN-Channel handle is illegal, or its associated hardware is not available + PCAN_CHANNEL_AVAILABLE = $01; // The PCAN-Channel handle is available to be connected (Plug&Play Hardware: it means furthermore that the hardware is plugged-in) + PCAN_CHANNEL_OCCUPIED = $02; // The PCAN-Channel handle is valid, and is already being used + PCAN_CHANNEL_PCANVIEW = PCAN_CHANNEL_AVAILABLE Or PCAN_CHANNEL_OCCUPIED; // The PCAN-Channel handle is already being used by a PCAN-View application, but is available to connect + + LOG_FUNCTION_DEFAULT = $00; // Logs system exceptions / errors + LOG_FUNCTION_ENTRY = $01; // Logs the entries to the PCAN-Basic API functions + LOG_FUNCTION_PARAMETERS = $02; // Logs the parameters passed to the PCAN-Basic API functions + LOG_FUNCTION_LEAVE = $04; // Logs the exits from the PCAN-Basic API functions + LOG_FUNCTION_WRITE = $08; // Logs the CAN messages passed to the CAN_Write function + LOG_FUNCTION_READ = $10; // Logs the CAN messages received within the CAN_Read function + LOG_FUNCTION_ALL = $FFFF;// Logs all possible information within the PCAN-Basic API functions + + TRACE_FILE_SINGLE = $00; // A single file is written until it size reaches PAN_TRACE_SIZE + TRACE_FILE_SEGMENTED = $01; // Traced data is distributed in several files with size PAN_TRACE_SIZE + TRACE_FILE_DATE = $02; // Includes the date into the name of the trace file + TRACE_FILE_TIME = $04; // Includes the start time into the name of the trace file + TRACE_FILE_OVERWRITE = $80; // Causes the overwriting of available traces (same name) + + FEATURE_FD_CAPABLE = $01; // Device supports flexible data-rate (CAN-FD) + + SERVICE_STATUS_STOPPED = $01; // The service is not running + SERVICE_STATUS_RUNNING = $04; // The service is running + + // PCAN message types + // + PCAN_MESSAGE_STANDARD = $00; // The PCAN message is a CAN Standard Frame (11-bit identifier) + PCAN_MESSAGE_RTR = $01; // The PCAN message is a CAN Remote-Transfer-Request Frame + PCAN_MESSAGE_EXTENDED = $02; // The PCAN message is a CAN Extended Frame (29-bit identifier) + PCAN_MESSAGE_FD = $04; // The PCAN message represents a FD frame in terms of CiA Specs + PCAN_MESSAGE_BRS = $08; // The PCAN message represents a FD bit rate switch (CAN data at a higher bit rate) + PCAN_MESSAGE_ESI = $10; // The PCAN message represents a FD error state indicator(CAN FD transmitter was error active) + PCAN_MESSAGE_STATUS = $80; // The PCAN message represents a PCAN status message + + // Frame Type / Initialization Mode + // + PCAN_MODE_STANDARD = PCAN_MESSAGE_STANDARD; // Mode is Standard (11-bit identifier) + PCAN_MODE_EXTENDED = PCAN_MESSAGE_EXTENDED; // Mode is Extended (29-bit identifier) + + + // Baud rate codes = BTR0/BTR1 register values for the CAN controller. + // You can define your own Baud rate with the BTROBTR1 register. + // Take a look at www.peak-system.com for our free software "BAUDTOOL" + // to calculate the BTROBTR1 register for every bit rate and sample point. + // + PCAN_BAUD_1M = $0014; // 1 MBit/s + PCAN_BAUD_800K = $0016; // 800 kBit/s + PCAN_BAUD_500K = $001C; // 500 kBit/s + PCAN_BAUD_250K = $011C; // 250 kBit/s + PCAN_BAUD_125K = $031C; // 125 kBit/s + PCAN_BAUD_100K = $432F; // 100 kBit/s + PCAN_BAUD_95K = $C34E; // 95,238 kBit/s + PCAN_BAUD_83K = $852B; // 83,333 kBit/s + PCAN_BAUD_50K = $472F; // 50 kBit/s + PCAN_BAUD_47K = $1414; // 47,619 kBit/s + PCAN_BAUD_33K = $8B2F; // 33,333 kBit/s + PCAN_BAUD_20K = $532F; // 20 kBit/s + PCAN_BAUD_10K = $672F; // 10 kBit/s + PCAN_BAUD_5K = $7F7F; // 5 kBit/s + + // Represents the configuration for a CAN bit rate + // Note: + // * Each parameter and its value must be separated with a '='. + // * Each pair of parameter/value must be separated using ','. + // + // Example: + // f_clock=80000000,nom_brp=0,nom_tseg1=13,nom_tseg2=0,nom_sjw=0,data_brp=0,data_tseg1=13,data_tseg2=0,data_sjw=0 + // + PCAN_BR_CLOCK = 'f_clock'; + PCAN_BR_CLOCK_MHZ = 'f_clock_mhz'; + PCAN_BR_NOM_BRP = 'nom_brp'; + PCAN_BR_NOM_TSEG1 = 'nom_tseg1'; + PCAN_BR_NOM_TSEG2 = 'nom_tseg2'; + PCAN_BR_NOM_SJW = 'nom_sjw'; + PCAN_BR_NOM_SAMPLE = 'nom_sam'; + PCAN_BR_DATA_BRP = 'data_brp'; + PCAN_BR_DATA_TSEG1 = 'data_tseg1'; + PCAN_BR_DATA_TSEG2 = 'data_tseg2'; + PCAN_BR_DATA_SJW = 'data_sjw'; + PCAN_BR_DATA_SAMPLE = 'data_ssp_offset'; + + // Type of PCAN (non plug&play) hardware + // + PCAN_TYPE_ISA = $01; // PCAN-ISA 82C200 + PCAN_TYPE_ISA_SJA = $09; // PCAN-ISA SJA1000 + PCAN_TYPE_ISA_PHYTEC = $04; // PHYTEC ISA + PCAN_TYPE_DNG = $02; // PCAN-Dongle 82C200 + PCAN_TYPE_DNG_EPP = $03; // PCAN-Dongle EPP 82C200 + PCAN_TYPE_DNG_SJA = $05; // PCAN-Dongle SJA1000 + PCAN_TYPE_DNG_SJA_EPP = $06; // PCAN-Dongle EPP SJA1000 + +type + //////////////////////////////////////////////////////////// + // Type definitions + //////////////////////////////////////////////////////////// + + TPCANHandle = Word; // Represents a PCAN hardware channel handle + TPCANStatus = Longword; // Represents a PCAN status/error code + TPCANParameter = Byte; // Represents a PCAN parameter to be read or set + TPCANDevice = Byte; // Represents a PCAN device + TPCANMessageType = Byte; // Represents the type of a PCAN message + TPCANType = Byte; // Represents the type of PCAN hardware to be initialized + TPCANMode = Byte; // Represents a PCAN filter mode + TPCANBaudrate = Word; // Represents a PCAN Baud rate register value + TPCANBitrateFD = PAnsiChar;// Represents a PCAN-FD bit rate string + TPCANTimestampFD = UInt64; // Represents a timestamp of a received PCAN FD message + + //////////////////////////////////////////////////////////// + // Structure definitions + //////////////////////////////////////////////////////////// + + // Represents a PCAN message + // + TPCANMsg = record + ID: Longword; // 11/29-bit message identifier + MSGTYPE: TPCANMessageType; // Type of the message + LEN: Byte; // Data Length Code of the message (0..8) + DATA: array[0..7] of Byte; // Data of the message (DATA[0]..DATA[7]) + end; + + // Represents a timestamp of a received PCAN message. + // Total Microseconds = micros + 1000 * millis + 0x100000000 * 1000 * millis_overflow + // + TPCANTimestamp = record + millis: Longword; // Base-value: milliseconds: 0.. 2^32-1 + millis_overflow: Word; // Roll-arounds of millis + micros: Word; // Microseconds: 0..999 + end; + PTPCANTimestamp = ^TPCANTimestamp; + + // Represents a PCAN message from a FD capable hardware + // + TPCANMsgFD = record + ID: Longword; // 11/29-bit message identifier + MSGTYPE: TPCANMessageType; // Type of the message + DLC: Byte; // Data Length Code of the message (0..15) + DATA: array[0..63] of Byte; // Data of the message (DATA[0]..DATA[63]) + end; + PTPCANTimestampFD = ^TPCANTimestampFD; + +//////////////////////////////////////////////////////////// +// PCAN-Basic API function declarations +//////////////////////////////////////////////////////////// + +/// +/// Initializes a PCAN Channel +/// +/// The handle of a PCAN Channel +/// The speed for the communication (BTR0BTR1 code) +/// NON PLUG&PLAY: The type of hardware and operation mode +/// NON PLUG&PLAY: The I/O address for the parallel port +/// NON PLUG&PLAY: Interrupt number of the parallel port +/// A TPCANStatus error code +function CAN_Initialize( + Channel: TPCANHandle; + Btr0Btr1: TPCANBaudrate; + HwType: TPCANType; + IOPort: LongWord; + Interrupt: Word + ): TPCANStatus; stdcall; + +/// +/// Initializes a FD capable PCAN Channel +/// +/// "The handle of a FD capable PCAN Channel" +/// "The speed for the communication (FD bit rate string)" +/// See PCAN_BR_* values +/// * parameter and values ust be separated by '=' +/// * Couples of Parameter/value must be separated by ',' +/// * Following Parameter must be filled out: f_clock, data_brp, data_sjw, data_tseg1, data_tseg2, +/// nom_brp, nom_sjw, nom_tseg1, nom_tseg2. +/// * Following Parameters are optional (not used yet): data_ssp_offset, nom_samp +/// +/// f_clock_mhz=80,nom_brp=0,nom_tseg1=13,nom_tseg2=0,nom_sjw=0,data_brp=0, +/// data_tseg1=13,data_tseg2=0,data_sjw=0 +/// "A TPCANStatus error code" +function CAN_InitializeFD( + Channel: TPCANHandle; + BitrateFD: TPCANBitrateFD + ): TPCANStatus; stdcall; + +/// +/// Uninitializes one or all PCAN Channels initialized by CAN_Initialize +/// +/// Giving the TPCANHandle value "PCAN_NONEBUS", +/// uninitialize all initialized channels +/// The handle of a PCAN Channel +/// A TPCANStatus error code +function CAN_Uninitialize( + Channel: TPCANHandle + ): TPCANStatus; stdcall; + +/// +/// Resets the receive and transmit queues of the PCAN Channel +/// +/// A reset of the CAN controller is not performed +/// The handle of a PCAN Channel +/// A TPCANStatus error code +function CAN_Reset( + Channel: TPCANHandle + ): TPCANStatus; stdcall; + +/// +/// Gets the current status of a PCAN Channel +/// +/// The handle of a PCAN Channel +/// A TPCANStatus error code +function CAN_GetStatus( + Channel: TPCANHandle + ): TPCANStatus; stdcall; + +/// +/// Reads a CAN message from the receive queue of a PCAN Channel +/// +/// The handle of a PCAN Channel +/// A TPCANMsg structure buffer to store the CAN message +/// A TPCANTimestamp structure buffer to get +/// the reception time of the message +/// A TPCANStatus error code +function CAN_Read( + Channel: TPCANHandle; + var MessageBuffer: TPCANMsg; + TimestampBuffer: PTPCANTimestamp + ):TPCANStatus; stdcall; + +/// +/// Reads a CAN message from the receive queue of a FD capable PCAN Channel +/// +/// "The handle of a FD capable PCAN Channel" +/// "A TPCANMsgFD structure buffer to store the CAN message" +/// "A TPCANTimestampFD buffer to get +/// the reception time of the message. If this value is not desired, this parameter +/// should be passed as NULL" +/// "A TPCANStatus error code" +function CAN_ReadFD( + Channel: TPCANHandle; + var MessageBuffer: TPCANMsgFD; + TimestampBuffer: PTPCANTimestampFD + ): TPCANStatus; stdcall; + +/// +/// Transmits a CAN message +/// +/// The handle of a PCAN Channel +/// A TPCANMsg buffer with the message to be sent +/// A TPCANStatus error code +function CAN_Write( + Channel: TPCANHandle; + var MessageBuffer: TPCANMsg + ): TPCANStatus; stdcall; + +/// +/// Transmits a CAN message over a FD capable PCAN Channel +/// +/// "The handle of a FD capable PCAN Channel" +/// "A TPCANMsgFD buffer with the message to be sent" +/// "A TPCANStatus error code" +function CAN_WriteFD( + Channel: TPCANHandle; + var MessageBuffer: TPCANMsgFD + ): TPCANStatus; stdcall; + +/// +/// Configures the reception filter +/// +/// The message filter will be expanded with every call to +/// this function. If it is desired to reset the filter, please use +/// the 'SetValue' function +/// The handle of a PCAN Channel +/// The lowest CAN ID to be received +/// The highest CAN ID to be received +/// Message type, Standard (11-bit identifier) or +/// Extended (29-bit identifier) +/// A TPCANStatus error code +function CAN_FilterMessages( + Channel: TPCANHandle; + FromID: LongWord; + ToID: LongWord; + Mode: TPCANMode + ): TPCANStatus; stdcall; + +/// +/// Retrieves a PCAN Channel value +/// +/// Parameters can be present or not according with the kind +/// of Hardware (PCAN Channel) being used. If a parameter is not available, +/// a PCAN_ERROR_ILLPARAMTYPE error will be returned +/// The handle of a PCAN Channel +/// The TPCANParameter parameter to get +/// Buffer for the parameter value +/// Size in bytes of the buffer +/// A TPCANStatus error code +function CAN_GetValue( + Channel: TPCANHandle; + Parameter: TPCANParameter; + Buffer: Pointer; + BufferLength: LongWord + ): TPCANStatus; stdcall; + +/// +/// Configures or sets a PCAN Channel value +/// +/// Parameters can be present or not according with the kind +/// of Hardware (PCAN Channel) being used. If a parameter is not available, +/// a PCAN_ERROR_ILLPARAMTYPE error will be returned +/// The handle of a PCAN Channel +/// The TPCANParameter parameter to set +/// Buffer with the value to be set +/// Size in bytes of the buffer +/// A TPCANStatus error code +function CAN_SetValue( + Channel: TPCANHandle; + Parameter: TPCANParameter; + Buffer: Pointer; + BufferLength: LongWord + ): TPCANStatus; stdcall; + +/// +/// Returns a descriptive text of a given TPCANStatus error +/// code, in any desired language +/// +/// The current languages available for translation are: +/// Neutral (0x00), German (0x07), English (0x09), Spanish (0x0A), +/// Italian (0x10) and French (0x0C) +/// A TPCANStatus error code +/// Indicates a 'Primary language ID' +/// Buffer for the text (must be at least 256 in length) +/// A TPCANStatus error code +function CAN_GetErrorText( + Error: TPCANStatus; + Language: Word; + StringBuffer: PAnsiChar + ): TPCANStatus; stdcall; + +implementation +uses SysUtils; + +const DLL_Name = 'PCANBASIC.DLL'; + +function CAN_Initialize(Channel: TPCANHandle; Btr0Btr1: TPCANBaudrate; HwType: TPCANType; IOPort: LongWord; Interrupt: Word): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_InitializeFD(Channel: TPCANHandle; BitrateFD: TPCANBitrateFD): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_Uninitialize(Channel: TPCANHandle): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_Reset(Channel: TPCANHandle): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_GetStatus(Channel: TPCANHandle): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_Read(Channel: TPCANHandle; var MessageBuffer: TPCANMsg; TimestampBuffer: PTPCANTimestamp):TPCANStatus; stdcall; +external DLL_Name; + +function CAN_ReadFD(Channel: TPCANHandle; var MessageBuffer: TPCANMsgFD; TimestampBuffer: PTPCANTimestampFD):TPCANStatus; stdcall; +external DLL_Name; + +function CAN_Write(Channel: TPCANHandle; var MessageBuffer: TPCANMsg): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_WriteFD(Channel: TPCANHandle; var MessageBuffer: TPCANMsgFD): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_FilterMessages(Channel: TPCANHandle; FromID: LongWord; ToID: LongWord; Mode: TPCANMode): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_GetValue(Channel: TPCANHandle; Parameter: TPCANParameter; Buffer: Pointer; BufferLength: LongWord): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_SetValue(Channel: TPCANHandle; Parameter: TPCANParameter; Buffer: Pointer; BufferLength: LongWord): TPCANStatus; stdcall; +external DLL_Name; + +function CAN_GetErrorText(Error: TPCANStatus; Language: Word; StringBuffer: PAnsiChar): TPCANStatus; stdcall; +external DLL_Name; + +end. \ No newline at end of file diff --git a/Host/Source/MicroBoot/interfaces/can/peak/PCANdrvD.pas b/Host/Source/MicroBoot/interfaces/can/peak/PCANdrvD.pas deleted file mode 100644 index dc43a464..00000000 --- a/Host/Source/MicroBoot/interfaces/can/peak/PCANdrvD.pas +++ /dev/null @@ -1,559 +0,0 @@ -unit PCANdrvD; -//*************************************************************************************** -// Project Name: TPCanDriver component for Borland Delphi -// Description: Encapsulates PCAN's Light driver into a VCL component for PCANUSB 1CH. -// File Name: PCANdrvD.pas -// -//--------------------------------------------------------------------------------------- -// C O P Y R I G H T -//--------------------------------------------------------------------------------------- -// Copyright (c) 2011 by Feaser http://www.feaser.com All rights reserved -// -// This software has been carefully tested, but is not guaranteed for any particular -// purpose. The author does not offer any warranties and does not guarantee the accuracy, -// adequacy, or completeness of the software and is not responsible for any errors or -// omissions or the results obtained from use of the software. -// -//--------------------------------------------------------------------------------------- -// L I C E N S E -//--------------------------------------------------------------------------------------- -// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or -// modify it under the terms of the GNU General Public License as published by the Free -// Software Foundation, either version 3 of the License, or (at your option) any later -// version. -// -// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; -// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -// PURPOSE. See the GNU General Public License for more details. -// -// You have received a copy of the GNU General Public License along with OpenBLT. It -// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. -// -//*************************************************************************************** -interface - - -//*************************************************************************************** -// Includes -//*************************************************************************************** -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Pcan_usb; - - -//*************************************************************************************** -// Type Definitions -//*************************************************************************************** -type - TPCanChannel = ( pcanchannel0 ); - TPCanHardware = ( PCAN_USB1CH ); - TPCanDirection = ( PcanTx, PCanRx ); - TPCanMessage = packed record - id : LongInt; - dlc : Byte; - data : array [0..7] of Byte; - time : LongInt; - ext : Boolean; - end; - -type - TPCanMessageEvent = procedure( Sender: TObject; Direction: TPCanDirection; Message: TPCanMessage ) of object; - -type - TPCanEventThread = class(TThread) - private - { Private declarations } - FMethod: TThreadMethod; - protected - procedure Execute; override; - public - property Method : TThreadMethod read FMethod write FMethod; - end; - -type - TPCanDriver = class(TComponent) - private - { Private declarations } - FCanEventThread: TPCanEventThread; - FThreadRunning : boolean; - FCanConnected : boolean; - FStartTickCnt : DWORD; - function IsThreadRunning: boolean; - procedure ProcessReception; - protected - { Protected declarations } - FBaudRate : LongInt; - FChannel : TPCanChannel; - FHardware : TPCanHardware; - FPriority : TThreadPriority; - FExtendedId : Boolean; - FOnMessage : TPCanMessageEvent; - procedure SetBaudRate( Value: LongInt ); - procedure SetChannel( Value: TPCanChannel ); - procedure SetHardware( Value: TPCanHardware ); - procedure SetPriority( Value: TThreadPriority ); - procedure SetExtendedId( Value: Boolean ); - public - { Public declarations } - constructor Create( AOwner: TComponent ); override; - destructor Destroy; override; - function Connect: boolean; virtual; - procedure Disconnect; virtual; - function Transmit( Message: TPCanMessage): boolean; virtual; - function IsConnected: boolean; virtual; - function IsComError: boolean; virtual; - published - { Published declarations } - property BaudRate : LongInt read FBaudRate write SetBaudRate default 500000; - property Channel : TPCanChannel read FChannel write SetChannel default pcanchannel0; - property Hardware : TPCanHardware read FHardware write SetHardware default PCAN_USB1CH; - property Priority : TThreadPriority read FPriority write SetPriority default tpNormal; - property ExtendedId : Boolean read FExtendedId write SetExtendedId default False; - property OnMessage : TPCanMessageEvent read FOnMessage write FOnMessage; - end; - - -//*************************************************************************************** -// Prototypes -//*************************************************************************************** -procedure Register; - -implementation -//*************************************************************************************** -// NAME: Execute -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Overriden Execute function for the CanEventThread. Calls and synchro- -// nizes with the TCanDriver.ProcessEvents function. -// -//*************************************************************************************** -procedure TPCanEventThread.Execute; -begin - while not Terminated do - begin - if Assigned(Method) then // make sure TPCanDriver.ProcessEvents is set - Synchronize(Method); // call and synchronize - end; -end; //*** end of Execute *** - - -//*************************************************************************************** -// NAME: Create -// PRECONDITIONS: none -// PARAMETER: AOwner : owner of the component -// RETURN VALUE: none -// DESCRIPTION: Component constructor. Calls TComponent's constructor and initializes -// the private property variables to their default values. -// -//*************************************************************************************** -constructor TPCanDriver.Create( AOwner: TComponent ); -begin - // call inherited constructor - inherited Create( AOwner ); - - // set defaults for internal variables - FThreadRunning := False; - FCanConnected := False; - - // set defaults for properties - FBaudRate := 500000; - FChannel := pcanchannel0; - FHardware := PCAN_USB1CH; - FPriority := tpNormal; - FExtendedId := False; -end; //*** end of Create *** - - -//*************************************************************************************** -// NAME: Destroy -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Component destructor. Calls TComponent's destructor -// -//*************************************************************************************** -destructor TPCanDriver.Destroy; -begin - Disconnect; // close the port and driver - inherited Destroy; // call inherited destructor -end; //*** end of Destroy *** - - -//*************************************************************************************** -// NAME: IsConnected -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: True or False -// DESCRIPTION: Determines whether or not the CAN driver is connected and active -// -//*************************************************************************************** -function TPCanDriver.IsConnected: boolean; -begin - Result := FCanConnected; -end; //*** end of IsConnected *** - - -//*************************************************************************************** -// NAME: IsComError -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: True if the communication interface is in error state, False otherwise -// DESCRIPTION: Determines whether or not the CAN controller is in error state. -// -//*************************************************************************************** -function TPCanDriver.IsComError: boolean; -begin - // check for bus off - result := ((CAN_Status and CAN_ERR_BUSOFF) <> 0); -end; //*** end of IsComError *** - - -//*************************************************************************************** -// NAME: IsThreadRunning -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: True or False -// DESCRIPTION: Determines whether or not the CAN event thread is running -// -//*************************************************************************************** -function TPCanDriver.IsThreadRunning: boolean; -begin - if FThreadRunning = True then - Result := True - else - Result := False; -end; //*** end of IsThreadRunning *** - - -//*************************************************************************************** -// NAME: SetBaudRate -// PRECONDITIONS: none -// PARAMETER: Value : new baudrate value [0 - 1000000 bps] -// RETURN VALUE: none -// DESCRIPTION: Configures the baudrate -// -// |------------------------------------------------------------------------------------ -// | Update baudrate configuration -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TPCanDriver.SetBaudRate( Value: LongInt ); -begin - FBaudRate := Value; // update property -end; //*** end of SetBaudRate *** - - -//*************************************************************************************** -// NAME: SetChannel -// PRECONDITIONS: none -// PARAMETER: Value : channel0 or channel1 -// RETURN VALUE: none -// DESCRIPTION: Configures the used CAN channel -// -// |------------------------------------------------------------------------------------ -// | Update channel configuration -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TPCanDriver.SetChannel( Value: TPCanChannel ); -begin - FChannel := Value; -end; //*** end of SetChannel *** - - -//*************************************************************************************** -// NAME: SetHardware -// PRECONDITIONS: none -// PARAMETER: Value : type of CAN hardware (Virtual, CANcardXL, etc.) -// RETURN VALUE: none -// DESCRIPTION: Configures the used CAN hardware -// -// |------------------------------------------------------------------------------------ -// | Update hardware configuration -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TPCanDriver.SetHardware( Value: TPCanHardware ); -begin - FHardware := Value; -end; //*** end of SetHardware *** - - -//*************************************************************************************** -// NAME: SetPriority -// PRECONDITIONS: none -// PARAMETER: Value : thread priority -// RETURN VALUE: none -// DESCRIPTION: Configures the priority for the CAN event thread -// -// |------------------------------------------------------------------------------------ -// | y\ Is Thread running? /n -// |------------------------------------------------------------------------------------ -// | Stop Thread | -// | Update Thread priority | Update Thread priority -// | Restart Thread | -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TPCanDriver.SetPriority( Value: TThreadPriority ); -begin - if IsThreadRunning then - begin - FCanEventThread.Suspend; // suspend the thread - FPriority := Value; // update the priority - FCanEventThread.Resume; // resume the thread - end - else - begin - FPriority := Value; // update the priority - end; -end; //*** end of SetPriority *** - - -//*************************************************************************************** -// NAME: SetExtendedId -// PRECONDITIONS: none -// PARAMETER: Value : true = support only 29-bit id's, false = support only 11-bit -// RETURN VALUE: none -// DESCRIPTION: Configures the support of extended 29-bit identifiers -// -// |------------------------------------------------------------------------------------ -// | Update extended id support selection -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TPCanDriver.SetExtendedId( Value: Boolean ); -begin - FExtendedId := Value; -end; //*** end of SetExtendedId ***/ - - -//*************************************************************************************** -// NAME: Connect -// PRECONDITIONS: Disconnected from CAN bus -// PARAMETER: none -// RETURN VALUE: True or False for succees or error, respectively -// DESCRIPTION: Initializes the CAN driver and synchronizes the hardware with the CAN -// bus. -// -//*************************************************************************************** -function TPCanDriver.Connect: boolean; -var - Baudcode : Word; - MsgType : Integer; - -begin - Result := False; - FThreadRunning := False; - FCanConnected := False; - - // convert baudrate in bps to supported baudrate code - Baudcode := CAN_BAUD_500K; // init local - case FBaudRate of - 5000 : Baudcode := CAN_BAUD_5K; - 10000 : Baudcode := CAN_BAUD_10K; - 20000 : Baudcode := CAN_BAUD_20K; - 33333 : Baudcode := $1D14; - 50000 : Baudcode := CAN_BAUD_50K; - 83333 : Baudcode := $4B14; - 100000 : Baudcode := CAN_BAUD_100K; - 125000 : Baudcode := CAN_BAUD_125K; - 250000 : Baudcode := CAN_BAUD_250K; - 500000 : Baudcode := CAN_BAUD_500K; - 1000000 : Baudcode := CAN_BAUD_1M; - end; - - // convert extented id info - if FExtendedId then - MsgType := 1 - else - MsgType := 0; - - //-------------------------- open the driver ------------------------------------------ - if CAN_Init(Baudcode, MsgType) <> CAN_ERR_OK then Exit; - - - - //-------------------------- open the acceptance filter -------------------------------- - if CAN_ResetFilter <> CAN_ERR_OK then - begin - CAN_Close; - Exit; - end; - - if FExtendedId then - begin - if CAN_MsgFilter($000, $1FFFFFFF, MSGTYPE_EXTENDED) <> CAN_ERR_OK then - begin - CAN_Close; - Exit; - end; - end - else - begin - if CAN_MsgFilter($000, $7FF, MSGTYPE_STANDARD) <> CAN_ERR_OK then - begin - CAN_Close; - Exit; - end; - end; - - //-------------------------- reset message queues ------------------------------------- - if CAN_ResetClient <> CAN_ERR_OK then - begin - CAN_Close; - Exit; - end; - - //-------------------------- start CAN event thread ----------------------------------- - FCanEventThread := TPCanEventThread.Create(True); // create and suspend - FCanEventThread.FreeOnTerminate := True; // auto free on termination - FCanEventThread.Method := ProcessReception; // set method - FCanEventThread.Resume; // start - FThreadRunning := True; - - - //-------------------------- store start time for time stamps ------------------------- - FStartTickCnt := GetTickCount; - - //-------------------------- success -------------------------------------------------- - FCanConnected := True; - Result := True; // successfully initialized the driver -end; //*** end of Connect *** - - -//*************************************************************************************** -// NAME: Disconnect -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Disconnects the CAN driver -// -//*************************************************************************************** -procedure TPCanDriver.Disconnect; -begin - if IsConnected = True then // are we connected? - begin - FCanConnected := False; - // close the channel - CAN_Close; - end; - - if IsThreadRunning then - begin - FCanEventThread.Terminate; // stop - FThreadRunning := False; - end; -end; //*** end of Disconnect *** - - -//*************************************************************************************** -// NAME: Transmit -// PRECONDITIONS: Driver initialized using 'Connect' -// PARAMETER: Message: CAN message that is to be transmitted -// RETURN VALUE: True or False for succees or error, respectively -// DESCRIPTION: Transmits a CAN message. -// -//*************************************************************************************** -function TPCanDriver.Transmit( Message: TPCanMessage): boolean; -var - cnt : Byte; - msg : TPCANMsg; - msgcpy : TPCanMessage; -begin - // make sure the CAN driver is connected - if not IsConnected then - begin - Result := False; // can't transmit it not connected - exit; // no need to continue - end; - - // set the message identifier - msg.ID := Message.id; - if Message.ext then - msg.MSGTYPE := MSGTYPE_EXTENDED - else - msg.MSGTYPE := MSGTYPE_STANDARD; - - // set the data length - msg.LEN := Message.dlc; - - // store the data bytes - for cnt :=0 to Message.dlc do - begin - msg.DATA[cnt] := Message.data[cnt]; - end; - - // submit the transmit request - if CAN_Write(msg) <> CAN_ERR_OK then - begin - Result := False; - exit; - end; - - //---------------- process transmission confirmation -------------------------- - if Assigned( FOnMessage ) then - begin - msgcpy := Message; - msgcpy.time := GetTickCount - FStartTickCnt; - FOnMessage( Self, PCanTx, msgcpy ); // call application's event handler - end; - - Result := True; -end; //*** end of Transmit *** - - -//*************************************************************************************** -// NAME: ProcessReception -// PRECONDITIONS: thread running -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Called by the CAN event tread. This function traps and processes CAN -// events for OnMessage. -// -//*************************************************************************************** -procedure TPCanDriver.ProcessReception; -var - cnt : Byte; - msg : TPCanMessage; - msgraw : TPCANMsg; -begin - //---------------- process reception indication ------------------------------- - // continue only if a new message is present in the queue - if CAN_Read(msgraw) <> CAN_ERR_OK then - Exit; - - // only process CAN messages and not the status messages - if (msgraw.MSGTYPE = MSGTYPE_EXTENDED) or (msgraw.MSGTYPE = MSGTYPE_STANDARD) then - begin - // copy the message info - msg.time := GetTickCount - FStartTickCnt; - msg.id := msgraw.ID; - msg.dlc := msgraw.LEN; - // store the data bytes - for cnt :=0 to msg.dlc do - begin - msg.data[cnt] := msgraw.DATA[cnt]; - end; - - if Assigned( FOnMessage ) then - begin - FOnMessage( Self, PCanRx, msg ); // call application's event handler - end; - end; -end; //*** end of ProcessReception *** - - -//*************************************************************************************** -// NAME: Register -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Registers the TPCanDriver component into Borland Delphi's IDE. -// -//*************************************************************************************** -procedure Register; -begin - RegisterComponents('Feaser', [TPCanDriver]); -end; //*** end of Register *** - - -end. -//********************************** end of PCANdrvD.pas ******************************** - - diff --git a/Host/Source/MicroBoot/interfaces/can/peak/Pcan_usb.pas b/Host/Source/MicroBoot/interfaces/can/peak/Pcan_usb.pas deleted file mode 100644 index 2c7a4259..00000000 --- a/Host/Source/MicroBoot/interfaces/can/peak/Pcan_usb.pas +++ /dev/null @@ -1,372 +0,0 @@ -/////////////////////////////////////////////////////////////////////////////// -// PCAN-Light -// PCAN_USB.pas -// -// Version 2.x -// -// ~~~~~~~~~~ -// -// Definition of the PCAN-Light API. -// The Driver support a Hardware and a Software who want to communicate with CAN-busses -// -// ~~~~~~~~~~~~ -// -// PCAN-Light-API -// -// ~~~~~~~~~~~~ -// -// - CAN_Init(wBTR0BTR1: Word; CANMsgType: Integer) -// - CAN_Close() -// - CAN_Status() -// - CAN_Write(var MsgBuff: TPCANMsg) -// - CAN_Read(var MsgBuff: TPCANMsg) -// - CAN_ReadEx(var MsgBuff: TPCANMsg; var RcvTime: TPCANTimestamp) -// - CAN_VersionInfo(lpszTextBuff: PChar) -// - CAN_DLLVersionInfo(lpszTextBuff: PChar) -// - CAN_SpecialFunktion(distributorcode: LongWord; codenumber: Integer) -// - CAN_ResetClient() -// - CAN_MsgFilter(FromID, ToID: LongWord; _Type: Integer) -// - CAN_ResetFilter() -// - SetUSBDeviceNr(DevNum: Integer) -// - GetUSBDeviceNr(var DevNum: Integer) -// - CAN_SetRcvFunc(hEvent: THandle) -// -// ------------------------------------------------------------------ -// Author : Hoppe, Wilhelm -// Modified By: Wagner (29.09.2009) -// -// Language: PASCAL OO -// ------------------------------------------------------------------ -// -// Copyright (C) 1999-2009 PEAK-System Technik GmbH, Darmstadt -// -unit pcan_usb; - -interface - -const - // Constants definitions - Frame Type - // - CAN_INIT_TYPE_EX = $01; //Extended Frame - CAN_INIT_TYPE_ST = $00; //Standart Frame - - // Constants definitions - ID - // - CAN_MAX_STANDARD_ID = $7ff; - CAN_MAX_EXTENDED_ID = $1fffffff; - - // Constants definitions - CAN message types - // - MSGTYPE_STANDARD = $00; // Standard Data frame (11-bit ID) - MSGTYPE_RTR = $01; // 1, if Remote Request frame - MSGTYPE_EXTENDED = $02; // 1, if Extended Data frame (CAN 2.0B, 29-bit ID) - MSGTYPE_ERROR = $80; // 1, if Status information - - // Baud rate codes = BTR0/BTR1 register values for the CAN controller. - // You can define your own Baudrate with the BTROBTR1 register !! - // take a look at www.peak-system.com for our software BAUDTOOL to - // calculate the BTROBTR1 register for every baudrate and sample point. - // - CAN_BAUD_1M = $0014; // 1 MBit/s - CAN_BAUD_500K = $001C; // 500 kBit/s - CAN_BAUD_250K = $011C; // 250 kBit/s - CAN_BAUD_125K = $031C; // 125 kBit/s - CAN_BAUD_100K = $432F; // 100 kBit/s - CAN_BAUD_50K = $472F; // 50 kBit/s - CAN_BAUD_20K = $532F; // 20 kBit/s - CAN_BAUD_10K = $672F; // 10 kBit/s - CAN_BAUD_5K = $7F7F; // 5 kBit/s - - // Error codes (bit code) - // - CAN_ERR_OK = $0000; // No error - CAN_ERR_XMTFULL = $0001; // Transmit buffer in CAN controller is full - CAN_ERR_OVERRUN = $0002; // CAN controller was read too late - CAN_ERR_BUSLIGHT = $0004; // Bus error: an error counter reached the 'light' limit - CAN_ERR_BUSHEAVY = $0008; // Bus error: an error counter reached the 'heavy' limit - CAN_ERR_BUSOFF = $0010; // Bus error: the CAN controller is in bus-off state - CAN_ERR_QRCVEMPTY = $0020; // Receive queue is empty - CAN_ERR_QOVERRUN = $0040; // Receive queue was read too late - CAN_ERR_QXMTFULL = $0080; // Transmit queue ist full - CAN_ERR_REGTEST = $0100; // Test of the CAN controller hardware registers failed (no hardware found) - CAN_ERR_NOVXD = $0200; // Driver not loaded - CAN_ERR_NODRIVER = $0200; // Driver not loaded - CAN_ERRMASK_ILLHANDLE=$1C00; // Mask for all handle errors - CAN_ERR_HWINUSE = $0400; // Hardware already in use by a Net - CAN_ERR_NETINUSE = $0800; // a Client is already connected to the Net - CAN_ERR_ILLHW = $1400; // Hardware handle is invalid - CAN_ERR_ILLNET = $1800; // Net handle is invalid - CAN_ERR_ILLCLIENT = $1C00; // Client handle is invalid - CAN_ERR_RESOURCE = $2000; // Resource (FIFO, Client, timeout) cannot be created - CAN_ERR_ILLPARAMTYPE = $4000; // Invalid parameter - CAN_ERR_ILLPARAMVAL = $8000; // Invalid parameter value - CAN_ERR_UNKNOWN = $10000; // Unknown error - CAN_ERR_ANYBUSERR = (CAN_ERR_BUSLIGHT or CAN_ERR_BUSHEAVY or CAN_ERR_BUSOFF); - - -type - // CAN Message - // - TPCANMsg = record - ID: LongWord; // 11/29 bit identifier - MSGTYPE: Byte; // Bits from MSGTYPE_* - LEN: Byte; // Data Length Code of the Msg (0..8) - DATA: array[0..7] of Byte; // Data 0 .. 7 - end; - - // Timestamp of a receive/transmit event - // Total microseconds = micros + 1000 * millis + 0xFFFFFFFF * 1000 * millis_overflow - // - TPCANTimestamp = record - millis: LongWord; // Base-value: milliseconds: 0.. 2^32-1 - millis_overflow: Word; // Roll-arounds of millis - micros: Word; // Microseconds: 0..999 - end; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_Init() -// This function make the following: -// - Activate a Hardware -// - Make a Register Test of 82C200/SJA1000 -// - Allocate a Send buffer and a Hardware handle -// - Programs the configuration of the transmit/receive driver -// - Set the Baudrate register -// - Set the Controller in RESET condition -// -// If CANMsgType=0 ---> ID 11Bit -// If CANMsgType=1 ---> ID 11/29Bit -// -// Possible Errors: NOVXD ILLHW REGTEST RESOURCE -// -function CAN_Init(wBTR0BTR1: Word; - CANMsgType: Integer): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_Close() -// This function terminate and release the configured hardware and all -// allocated resources -// -// Possible Errors: NOVXD -// -function CAN_Close: LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_Status() -// This function request the current status of the hardware (b.e. BUS-OFF) -// -// Possible Errors: NOVXD BUSOFF BUSHEAVY OVERRUN -// -function CAN_Status: LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_Write() -// This function Place a CAN message into the Transmit Queue of the CAN Hardware -// -// Possible Errors: NOVXD RESOURCE BUSOFF QXMTFULL -// -function CAN_Write(var MsgBuff: TPCANMsg): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_Read() -// This function get the next message or the next error from the Receive Queue of -// the CAN Hardware. -// REMARK: -// - Check always the type of the received Message (MSGTYPE_STANDARD,MSGTYPE_RTR, -// MSGTYPE_EXTENDED,MSGTYPE_STATUS) -// - The function will return ERR_OK always that you receive a CAN message successfully -// although if the messages is a MSGTYPE_STATUS message. -// - When a MSGTYPE_STATUS mesasge is got, the ID and Length information of the message -// will be treated as indefined values. Actually information of the received message -// should be interpreted using the first 4 data bytes as follow: -// * Data0 Data1 Data2 Data3 Kind of Error -// 0x00 0x00 0x00 0x02 CAN_ERR_OVERRUN 0x0002 CAN Controller was read to late -// 0x00 0x00 0x00 0x04 CAN_ERR_BUSLIGHT 0x0004 Bus Error: An error counter limit reached (96) -// 0x00 0x00 0x00 0x08 CAN_ERR_BUSHEAVY 0x0008 Bus Error: An error counter limit reached (128) -// 0x00 0x00 0x00 0x10 CAN_ERR_BUSOFF 0x0010 Bus Error: Can Controller went "Bus-Off" -// - If a CAN_ERR_BUSOFF status message is received, the CAN Controller must to be -// initialized again using the Init() function. Otherwise, will be not possible -// to send/receive more messages. -// - The message will be written to 'msgbuff'. -// -// Possible Errors: NOVXD QRCVEMPTY -// -function CAN_Read(var MsgBuff: TPCANMsg): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_ReadEx() -// This function get the next message or the next error from the Receive Queue of -// the CAN Hardware and the time when the message arrived. -// REMARK: -// - Check always the type of the received Message (MSGTYPE_STANDARD,MSGTYPE_RTR, -// MSGTYPE_EXTENDED,MSGTYPE_STATUS) -// - The function will return ERR_OK always that you receive a CAN message successfully -// although if the messages is a MSGTYPE_STATUS message. -// - When a MSGTYPE_STATUS mesasge is got, the ID and Length information of the message -// will be treated as indefined values. Actually information of the received message -// should be interpreted using the first 4 data bytes as follow: -// * Data0 Data1 Data2 Data3 Kind of Error -// 0x00 0x00 0x00 0x02 CAN_ERR_OVERRUN 0x0002 CAN Controller was read to late -// 0x00 0x00 0x00 0x04 CAN_ERR_BUSLIGHT 0x0004 Bus Error: An error counter limit reached (96) -// 0x00 0x00 0x00 0x08 CAN_ERR_BUSHEAVY 0x0008 Bus Error: An error counter limit reached (128) -// 0x00 0x00 0x00 0x10 CAN_ERR_BUSOFF 0x0010 Bus Error: Can Controller went "Bus-Off" -// - If a CAN_ERR_BUSOFF status message is received, the CAN Controller must to be -// initialized again using the Init() function. Otherwise, will be not possible -// to send/receive more messages. -// - The message will be written to 'msgbuff'. -// Since Version 2.x the Ext. Version is available - new Parameter: -// - Receive timestamp -// -// Possible Errors: NOVXD QRCVEMPTY -// -function CAN_ReadEx( - var MsgBuff: TPCANMsg; - var RcvTime: TPCANTimestamp - ): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_VersionInfo() -// This function get the Version and copyright of the hardware as text -// (max. 255 characters) -// -// Possible Errors: NOVXD -// -function CAN_VersionInfo( - lpszTextBuff: PChar - ): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_DLLVersionInfo() -// This function is used to get the Version and copyright of the DLL as -// text (max. 255 characters) -// -// Possible Errors: -1 for NULL-Pointer parameters :-) -// -function CAN_DLLVersionInfo( - lpszTextBuff: PChar - ): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_SpecialFunktion() -// This function is an special function to be used "ONLY" for distributors -// Return: 1 - the given parameters and the parameters in the hardware agree -// 0 - otherwise -// -// Possible Errors: NOVXD -// -function CAN_SpecialFunktion( - distributorcode: LongWord; - codenumber: Integer - ): LongWord; stdcall; - -////////////////////////////////////////////////////////////////////////////// -// CAN_ResetClient() -// This function delete the both queues (Transmit,Receive) of the CAN Controller -// using a RESET -// -// Possible Errors: ERR_ILLCLIENT ERR_NOVXD -// -function CAN_ResetClient: LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_MsgFilter(FromID, ToID, int Type) -// This function set the receive message filter of the CAN Controller. -// REMARK: -// - A quick register of all messages is possible using the parameters FromID and ToID = 0 -// - Every call of this function maybe cause an extention of the receive filter of the -// CAN controller, which one can go briefly to RESET -// - New in Ver 2.x: -// * Standard frames will be put it down in the acc_mask/code as Bits 28..13 -// * Hardware driver for 82C200 must to be moved to Bits 10..0 again! -// WARNING: -// It is not guaranteed to receive ONLY the registered messages. -// -// Possible Errors: NOVXD ILLCLIENT ILLNET REGTEST -// -function CAN_MsgFilter(FromID, ToID: LongWord; _Type: Integer): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_ResetFilter() -// This function close completely the Message Filter of the Hardware. -// They will be no more messages received. -// -// Possible Errors: NOVXD -// -function CAN_ResetFilter: LongWord; stdcall; - -////////////////////////////////////////////////////////////////////////////// -// SetUSBDeviceNr() -// This function set an identification number to the USB CAN hardware -// -// Possible Errors: NOVXD ILLHW ILLPARAMTYPE ILLPARAMVAL REGTEST -// -function SetUSBDeviceNr(DevNum: LongWord): LongWord; stdcall; - -////////////////////////////////////////////////////////////////////////////// -// GetUSBDeviceNr() -// This function read the device number of a USB CAN Hardware -// -// Possible Errors: NOVXD ILLHW ILLPARAMTYPE -// -function GetUSBDeviceNr(var DevNum: LongWord): LongWord; stdcall; - -/////////////////////////////////////////////////////////////////////////////// -// CAN_SetRcvEvent() -// This function is used to set the Event for the Event Handler -// -// Possible Errors: ILLCLIENT ILLPARAMTYPE ILLPARAMVAL NOVXD -// -function CAN_SetRcvEvent(hEvent: LongInt): LongWord; stdcall; - - -implementation - -uses SysUtils; - -const DLL_Name = 'PCAN_USB.dll'; - -function CAN_Init(wBTR0BTR1: Word; CANMsgType: Integer): LongWord; stdcall; -external DLL_Name; - -function CAN_Close: LongWord; stdcall; -external DLL_Name; - -function CAN_Status: LongWord; stdcall; -external DLL_Name; - -function CAN_Write(var MsgBuff: TPCANMsg): LongWord; stdcall; -external DLL_Name; - -function CAN_Read(var MsgBuff: TPCANMsg): LongWord; stdcall; -external DLL_Name; - -function CAN_ReadEx(var MsgBuff: TPCANMsg; var RcvTime: TPCANTimestamp): LongWord; stdcall; -external DLL_NAME; - -function CAN_VersionInfo(lpszTextBuff: PChar): LongWord; stdcall; -external DLL_Name; - -function CAN_DLLVersionInfo(lpszTextBuff: PChar): LongWord; stdcall; -external DLL_Name; - -function CAN_SpecialFunktion(distributorcode: LongWord; codenumber: Integer): LongWord; stdcall; -external DLL_Name; - -function CAN_ResetClient: LongWord; stdcall; -external DLL_Name; - -function CAN_MsgFilter(FromID, ToID: LongWord; _Type: Integer): LongWord; stdcall; -external DLL_Name; - -function CAN_ResetFilter: LongWord; stdcall; -external DLL_Name; - -function SetUSBDeviceNr(DevNum: LongWord): LongWord; stdcall; -external DLL_Name; - -function GetUSBDeviceNr(var DevNum: LongWord): LongWord; stdcall; -external DLL_Name; - -function CAN_SetRcvEvent(hEvent: LongInt):LongWord; stdcall; -external DLL_Name; - -end. diff --git a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm index 8bb21c85..22d0b1cc 100644 Binary files a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm and b/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.dfm differ diff --git a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas index ec639384..7e312609 100644 --- a/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas +++ b/Host/Source/MicroBoot/interfaces/can/peak/XcpSettings.pas @@ -36,7 +36,7 @@ interface //*************************************************************************************** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ComCtrls, ExtCtrls, IniFiles; + StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage; //*************************************************************************************** @@ -60,7 +60,6 @@ type cmbChannel: TComboBox; lblBaudRate: TLabel; chbExtendedId: TCheckBox; - edtBaudRate: TEdit; lblT1: TLabel; lblT3: TLabel; lblT4: TLabel; @@ -83,13 +82,22 @@ type openDialog: TOpenDialog; edtTconnect: TEdit; lblTconnect: TLabel; + cmbBaudrate: TComboBox; procedure btnOKClick(Sender: TObject); procedure btnCancelClick(Sender: TObject); procedure btnBrowseClick(Sender: TObject); + procedure cmbHardwareChange(Sender: TObject); + procedure edtTransmitIdChange(Sender: TObject); + procedure edtTransmitIdKeyPress(Sender: TObject; var Key: Char); + procedure edtReceiveIdKeyPress(Sender: TObject; var Key: Char); + procedure edtReceiveIdChange(Sender: TObject); private { Private declarations } + procedure ValidateHexCanIdInputChange(EdtID: TEdit); + procedure ValidateHexCanIdInputPress(Sender: TObject; var Key: char); public { Public declarations } + procedure SetAvailableChannels; end; type @@ -106,6 +114,187 @@ type implementation {$R *.DFM} + +//*************************************************************************************** +// NAME: SetAvailableChannels +// PARAMETER: none +// RETURN VALUE: none +// DESCRIPTION: Updates the items in the channels combobox based on the selected +// hardware. +// +//*************************************************************************************** +procedure TXcpSettingsForm.SetAvailableChannels; +var + maxChannels: Integer; + channelCnt: Integer; + oldSelectedIdx: Integer; +begin + // init to safe value + maxChannels := 2; + + case cmbHardware.ItemIndex of + 0 , 1: { PCAN USB or PCAN PCI } + begin + maxChannels := 8; + end; + 2: { PCAN PC Card } + begin + maxChannels := 2; + end; + end; + + // backup currently selected channel + oldSelectedIdx := cmbChannel.ItemIndex; + + // update the combobox contents + cmbChannel.Items.Clear; + for channelCnt := 1 to maxChannels do + begin + cmbChannel.Items.Add('Channel' + InttoStr(channelCnt)); + end; + cmbChannel.DropDownCount := maxChannels; + + // restore the selected channel + if oldSelectedIdx >= (maxChannels) then + begin + cmbChannel.ItemIndex := 0; + end + else + begin + cmbChannel.ItemIndex := oldSelectedIdx; + end; +end; //*** end of SetAvailableChannels *** + + +//*************************************************************************************** +// NAME: ValidateHexCanIdInputChange +// PARAMETER: EdtID Signal source. +// RETURN VALUE: none. +// DESCRIPTION: Checks to see if a valid hexadecimal CAN identifier was entered in +// the specified edit box. Should be called in the edit box's onChange +// event handler. +// +//*************************************************************************************** +procedure TXcpSettingsForm.ValidateHexCanIdInputChange(EdtID: TEdit); +var + value: Int64; +begin + // prevent a message identifier > 0x1FFFFFFF from being entered + if EdtID.Text <> '' then + begin + try + value := StrToInt64('$' + EdtID.Text); + if value < 0 then + begin + EdtID.Text := '0'; + end + else if value > $1FFFFFFF then + begin + EdtID.Text := '1FFFFFFF'; + end; + // automatically set extended if flag + if value > $7ff then + chbExtendedId.Checked := True; + except + // use id 0 if a non hex value was entered, for example through copy-paste + EdtID.Text := '0'; + end; + end; +end; //*** end of ValidateHexCanIdInputChange *** + + +//*************************************************************************************** +// NAME: ValidateHexCanIdInputPress +// PARAMETER: Sender Signal source. +// Key The key's character code that was pressed. +// RETURN VALUE: none. +// DESCRIPTION: Checks to see if a valid hexadecimal CAN identifier was entered in +// the specified edit box. Should be called in the edit box's onPress +// event handler. +// +//*************************************************************************************** +procedure TXcpSettingsForm.ValidateHexCanIdInputPress(Sender: TObject; var Key: char); +begin + if not (AnsiChar(Key) In ['0'..'9', 'a'..'f', 'A'..'F', #8, ^V, ^C]) then // #8 = backspace + begin + // ignore it + Key := #0; + end; + // convert a..f to upper case + if AnsiChar(Key) In ['a'..'f'] then + begin + Key := UpCase(Key); + end; +end; //*** end of ValidateHexCanIdInputPress *** + + +//*************************************************************************************** +// NAME: cmbHardwareChange +// PARAMETER: none +// RETURN VALUE: modal result +// DESCRIPTION: Event handler for when the hardware combobox selection changed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.cmbHardwareChange(Sender: TObject); +begin + SetAvailableChannels; +end; //*** end of cmbHardwareChange *** + + +//*************************************************************************************** +// NAME: edtTransmitIdChange +// PARAMETER: Sender Signal source. +// RETURN VALUE: None. +// DESCRIPTION: Called when the text in the edit box changed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtReceiveIdChange(Sender: TObject); +begin + ValidateHexCanIdInputChange(edtReceiveId); +end; //*** end of edtReceiveIdChange *** + + +//*************************************************************************************** +// NAME: edtReceiveIdKeyPress +// PARAMETER: Sender Signal source. +// Key The key's character code that was pressed. +// RETURN VALUE: None. +// DESCRIPTION: Called when a key is pressed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtReceiveIdKeyPress(Sender: TObject; var Key: Char); +begin + ValidateHexCanIdInputPress(edtReceiveId, Key); +end; //*** end of edtReceiveIdKeyPress *** + + +//*************************************************************************************** +// NAME: edtTransmitIdChange +// PARAMETER: Sender Signal source. +// RETURN VALUE: None. +// DESCRIPTION: Called when the text in the edit box changed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtTransmitIdChange(Sender: TObject); +begin + ValidateHexCanIdInputChange(edtTransmitId); +end; //*** end of edtTransmitIdChange *** + + +//*************************************************************************************** +// NAME: edtTransmitIdKeyPress +// PARAMETER: Sender Signal source. +// Key The key's character code that was pressed. +// RETURN VALUE: None. +// DESCRIPTION: Called when a key is pressed. +// +//*************************************************************************************** +procedure TXcpSettingsForm.edtTransmitIdKeyPress(Sender: TObject; var Key: Char); +begin + ValidateHexCanIdInputPress(edtTransmitId, Key); +end; //*** end of edtTransmitIdKeyPress *** + + //*************************************************************************************** // NAME: btnOKClick // PARAMETER: none @@ -196,6 +385,7 @@ end; //*** end of Destroy *** function TXcpSettings.Configure : Boolean; var settingsIni: TIniFile; + settingsInt: Integer; begin // initialize the return value result := false; @@ -207,9 +397,22 @@ begin settingsIni := TIniFile.Create(FIniFile); // CAN related elements - FSettingsForm.cmbHardware.ItemIndex := settingsIni.ReadInteger('can', 'hardware', 0); - FSettingsForm.cmbChannel.ItemIndex := settingsIni.ReadInteger('can', 'channel', 0); - FSettingsForm.edtBaudRate.Text := IntToStr(settingsIni.ReadInteger('can', 'baudrate', 500)); + settingsInt := settingsIni.ReadInteger('can', 'hardware', 0); + if settingsInt > FSettingsForm.cmbHardware.Items.Count then + settingsInt := 0; + FSettingsForm.cmbHardware.ItemIndex := settingsInt; + FSettingsForm.SetAvailableChannels; + + settingsInt := settingsIni.ReadInteger('can', 'channel', 0); + if settingsInt >= FSettingsForm.cmbChannel.Items.Count then + settingsInt := 0; + FSettingsForm.cmbChannel.ItemIndex := settingsInt; + + settingsInt := settingsIni.ReadInteger('can', 'baudrate', 2); + if settingsInt >= FSettingsForm.cmbBaudrate.Items.Count then + settingsInt := 2; + FSettingsForm.cmbBaudrate.ItemIndex := settingsInt; + FSettingsForm.chbExtendedId.Checked := settingsIni.ReadBool('can', 'extended', false); FSettingsForm.edtTransmitId.Text := Format('%x',[settingsIni.ReadInteger('can', 'txid', $667)]); FSettingsForm.edtReceiveId.Text := Format('%x',[settingsIni.ReadInteger('can', 'rxid', $7e1)]); @@ -231,8 +434,9 @@ begin // set defaults // CAN related elements FSettingsForm.cmbHardware.ItemIndex := 0; + FSettingsForm.SetAvailableChannels; FSettingsForm.cmbChannel.ItemIndex := 0; - FSettingsForm.edtBaudRate.Text := IntToStr(500); + FSettingsForm.cmbBaudrate.ItemIndex := 2; FSettingsForm.chbExtendedId.Checked := false; FSettingsForm.edtTransmitId.Text := Format('%x',[$667]); FSettingsForm.edtReceiveId.Text := Format('%x',[$7e1]); @@ -258,7 +462,7 @@ begin // CAN related elements settingsIni.WriteInteger('can', 'hardware', FSettingsForm.cmbHardware.ItemIndex); settingsIni.WriteInteger('can', 'channel', FSettingsForm.cmbChannel.ItemIndex); - settingsIni.WriteInteger('can', 'baudrate', StrToInt(FSettingsForm.edtBaudRate.Text)); + settingsIni.WriteInteger('can', 'baudrate', FSettingsForm.cmbBaudrate.ItemIndex); settingsIni.WriteBool('can', 'extended', FSettingsForm.chbExtendedId.Checked); settingsIni.WriteInteger('can', 'txid', StrToInt('$'+FSettingsForm.edtTransmitId.Text)); settingsIni.WriteInteger('can', 'rxid', StrToInt('$'+FSettingsForm.edtReceiveId.Text)); diff --git a/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas index 020666f4..ef4183df 100644 --- a/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas +++ b/Host/Source/MicroBoot/interfaces/can/peak/XcpTransport.pas @@ -36,36 +36,35 @@ interface // Includes //*************************************************************************************** uses - Windows, Messages, SysUtils, Classes, Forms, IniFiles, PCANdrvD; + Windows, Messages, SysUtils, Classes, Forms, IniFiles, PCANBasic; //*************************************************************************************** // Global Constants //*************************************************************************************** -const kMaxPacketSize = 256; +// a CAN message can only have up to 8 bytes +const kMaxPacketSize = 8; //*************************************************************************************** // Type Definitions //*************************************************************************************** type - TXcpTransportInfo = (kNone, kResponse, kError); + TPCANhardware = ( PCAN_PCI = $40, PCAN_USB = $50, PCAN_PCC = $60 ); - -type TXcpTransport = class(TObject) private - comEventInfo : TXcpTransportInfo; - comEvent : THandle; packetTxId : LongWord; packetRxId : Longword; extendedId : Boolean; - procedure OnCanMessage(Sender: TObject; Direction: TPCanDirection; Message: TPCanMessage); - function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; + canHardware : TPCANhardware; { PCAN_xxx } + canChannel : Word; { currently supported is 1..8 } + canBaudrate : Word; { in bits/sec } + connected : Boolean; + function ConstructPeakHandle(hardware: TPCANhardware; channel: Word): TPCANHandle; public packetData : array[0..kMaxPacketSize-1] of Byte; packetLen : Word; - pcanDriver : TPCanDriver; constructor Create; procedure Configure(iniFile : string); function Connect: Boolean; @@ -90,22 +89,6 @@ begin // call inherited constructor inherited Create; - // reset can event info - comEventInfo := kNone; - - // create the event that requires manual reset - comEvent := CreateEvent(nil, True, False, nil); - - if comEvent = 0 then - Application.MessageBox( 'Could not obtain event placeholder.', - 'Error', MB_OK or MB_ICONERROR ); - - // create a pcan driver instance - pcanDriver := TPCanDriver.Create(nil); - - // set can driver event handlers - pcanDriver.OnMessage := OnCanMessage; - // reset the packet ids packetTxId := 0; packetRxId := 0; @@ -115,6 +98,9 @@ begin // reset packet length packetLen := 0; + + // disconnected by default + connected := false; end; //*** end of Create *** @@ -127,12 +113,6 @@ end; //*** end of Create *** //*************************************************************************************** destructor TXcpTransport.Destroy; begin - // release can driver instance - pcanDriver.Free; - - // release event handle - CloseHandle(comEvent); - // call inherited destructor inherited; end; //*** end of Destroy *** @@ -148,7 +128,6 @@ end; //*** end of Destroy *** procedure TXcpTransport.Configure(iniFile : string); var settingsIni : TIniFile; - hwIndex : integer; begin // read XCP configuration from INI if FileExists(iniFile) then @@ -156,24 +135,37 @@ begin // create ini file object settingsIni := TIniFile.Create(iniFile); + // set hardware configuration + case settingsIni.ReadInteger('can', 'hardware', 0) of + 0: canHardware := PCAN_USB; + 1: canHardware := PCAN_PCI; + 2: canHardware := PCAN_PCC; + else + canHardware := PCAN_USB; + end; + canChannel := settingsIni.ReadInteger('can', 'channel', 0) + 1; + + case settingsIni.ReadInteger('can', 'baudrate', 2) of + 0: canBaudrate := PCAN_BAUD_1M; + 1: canBaudrate := PCAN_BAUD_800K; + 2: canBaudrate := PCAN_BAUD_500K; + 3: canBaudrate := PCAN_BAUD_250K; + 4: canBaudrate := PCAN_BAUD_125K; + 5: canBaudrate := PCAN_BAUD_100K; + 6: canBaudrate := PCAN_BAUD_83K; + 7: canBaudrate := PCAN_BAUD_33K; + 8: canBaudrate := PCAN_BAUD_20K; + 9: canBaudrate := PCAN_BAUD_10K; + 10: canBaudrate := PCAN_BAUD_5K; + else + canBaudrate := PCAN_BAUD_500K; + end; + // set message configuration packetTxId := settingsIni.ReadInteger('can', 'txid', $667); packetRxId := settingsIni.ReadInteger('can', 'rxid', $7e1); extendedId := settingsIni.ReadBool('can', 'extended', false); - // configure can hardware - hwIndex := settingsIni.ReadInteger('can', 'hardware', 0); - pcanDriver.Hardware := PCAN_USB1CH; // init to PCAN_USB1CH - case hwIndex of - 0 : pcanDriver.Hardware := PCAN_USB1CH; - end; - - // configure baudrate - pcanDriver.BaudRate := settingsIni.ReadInteger('can', 'baudrate', 500) * 1000; - - // only 1 channel on PCAN USB 1CH - pcanDriver.Channel := pcanchannel0; - // release ini file object settingsIni.Free; end; @@ -188,10 +180,33 @@ end; //*** end of Configure *** // //*************************************************************************************** function TXcpTransport.Connect: Boolean; +var + status: TPCANStatus; + iBuffer : Integer; begin - result := true; - if not pcanDriver.Connect then - result := false; + // init result value + result := false; + + // disconnect first if still connected + if connected then + Disconnect; + + // attempt to connect to the CAN hardware interface + status := CAN_Initialize(ConstructPeakHandle(canHardware, canChannel), canBaudrate, 0, 0, 0); + + // process the result + if status = PCAN_ERROR_OK then + begin + // connected. now enable the bus off automatic reset + iBuffer := PCAN_PARAMETER_ON; + status := CAN_SetValue(ConstructPeakHandle(canHardware, canChannel), PCAN_BUSOFF_AUTORESET, + PLongWord(@iBuffer), sizeof(iBuffer)); + if status = PCAN_ERROR_OK then + begin + connected := true; + result := true; + end; + end; end; //*** end of Connect *** @@ -203,8 +218,21 @@ end; //*** end of Connect *** // //*************************************************************************************** function TXcpTransport.IsComError: Boolean; +var + status: TPCANStatus; begin - result := pcanDriver.IsComError; + // init result to no error. + result := false; + + // check for bus off error if connected + if connected then + begin + status := CAN_GetStatus(ConstructPeakHandle(canHardware, canChannel)); + if (status = PCAN_ERROR_BUSOFF) or (status = PCAN_ERROR_BUSHEAVY) then + begin + result := true; + end; + end; end; //*** end of IsComError *** @@ -218,57 +246,89 @@ end; //*** end of IsComError *** //*************************************************************************************** function TXcpTransport.SendPacket(timeOutms: LongWord): Boolean; var - pcanmsg : TPCanMessage; - cnt : byte; - waitResult: Integer; + txMsg: TPCANMsg; + rxMsg: TPCANMsg; + byteIdx: Byte; + status: TPCANStatus; + responseReceived: Boolean; + timeoutTime: DWORD; begin - // do not send any more data on the network when we are in bus off state. - if IsComError then + // initialize the result value + result := false; + + // do not send data when the packet length is invalid or when not connected + // to the CAN hardware + if (packetLen > kMaxPacketSize) or (not connected) then begin - result := false; Exit; end; - // prepare the packet - pcanmsg.id := LongInt(PacketTxId); - pcanmsg.dlc := packetLen; - pcanmsg.ext := extendedId; - for cnt := 0 to packetLen-1 do + // prepare the packet for transmission in a CAN message + txMsg.ID := packetTxId; + if extendedId then + txMsg.MSGTYPE := PCAN_MESSAGE_EXTENDED + else + txMsg.MSGTYPE := PCAN_MESSAGE_STANDARD; + txMsg.LEN := packetLen; + for byteIdx := 0 to (packetLen-1) do begin - pcanmsg.data[cnt] := packetData[cnt]; + txMsg.DATA[byteIdx] := packetData[byteIdx]; end; - // make sure the event is reset - ResetEvent(comEvent); - comEventInfo := kNone; - - // submit the packet transmission request - if not pcanDriver.Transmit(pcanmsg) then + // transmit the packet via CAN + status := CAN_Write(ConstructPeakHandle(canHardware, canChannel), txMsg); + if status <> PCAN_ERROR_OK then begin - // unable to submit tx request - result := False; Exit; + end; - // packet is being transmitted. Now wait for the response to come in - waitResult := MsgWaitForSingleObject(comEvent, timeOutms); + // reset flag and set the reception timeout time + responseReceived := false; + timeoutTime := GetTickCount + timeOutms; - if waitResult <> WAIT_OBJECT_0 then + // attempt to receive the packet response within the timeout time + repeat + // read out the next message in the receive queue + status := CAN_Read(ConstructPeakHandle(canHardware, canChannel), rxMsg, nil); + // check if an error occurred + if (status <> PCAN_ERROR_OK) and (status <> PCAN_ERROR_QRCVEMPTY) then + begin + // error detected. stop loop. + Break; + end + // no error occurred, so either a message was received or the queue was + // empty. check for the latter condition + else if status = PCAN_ERROR_OK then + begin + // was the newly received CAN message the response we are waiting for? + if rxMsg.ID = packetRxId then + begin + // was the id type also a match? + if ((rxMsg.MSGTYPE = PCAN_MESSAGE_STANDARD) and (not extendedId)) or + ((rxMsg.MSGTYPE = PCAN_MESSAGE_EXTENDED) and (extendedId)) then + begin + // response received. set flag + responseReceived := true; + end; + end; + end; + // give the application a chance to use the processor + Application.ProcessMessages; + until (GetTickCount > timeoutTime) or (responseReceived); + + // check if the response was correctly received + if responseReceived then begin - // no com event triggered so either a timeout or internal error occurred - result := False; - Exit; + // copy the response for futher processing + packetLen := rxMsg.LEN; + for byteIdx := 0 to (packetLen-1) do + begin + packetData[byteIdx] := rxMsg.DATA[byteIdx]; + end; + // success + result := true; end; - - // com event was triggered. now check if the reponse was correctly received - if comEventInfo <> kResponse then - begin - result := False; - Exit; - end; - - // packet successfully transmitted and response packet received - result := True; end; //*** end of SendPacket *** @@ -281,97 +341,28 @@ end; //*** end of SendPacket *** //*************************************************************************************** procedure TXcpTransport.Disconnect; begin - pcanDriver.Disconnect; + // disconnect CAN interface if connected + if connected then + begin + CAN_Uninitialize(ConstructPeakHandle(canHardware, canChannel)); + end; + connected := false; end; //*** end of Disconnect *** //*************************************************************************************** -// NAME: OnCanMessage -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Can message event handler +// NAME: ConstructPeakHandle +// PARAMETER: hardware Peak hardware identifier. +// channel Peak channel. +// RETURN VALUE: Peak hardware channel handle. +// DESCRIPTION: Converts this class' hardware and channel values into a handle that +// can be passed to the Peak API. // //*************************************************************************************** -procedure TXcpTransport.OnCanMessage(Sender: TObject; Direction: TPCanDirection; Message: TPCanMessage); -var - cnt : integer; +function TXcpTransport.ConstructPeakHandle(hardware: TPCANhardware; channel: Word): TPCANHandle; begin - // the event we are interested in is the reception of the command response from - // slave. - if Direction = PCanRx then - begin - if Message.id = LongInt(PacketRxId) then - begin - // store response data - for cnt := 0 to Message.dlc-1 do - begin - packetData[cnt] := Message.data[cnt]; - end; - - // store response length - packetLen := Message.dlc; - - // set event flag - comEventInfo := kResponse; - - // trigger the event - SetEvent(comEvent); - end; - end; -end; //*** end of OnCanMessage *** - - -//*************************************************************************************** -// NAME: MsgWaitForSingleObject -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Improved version of WaitForSingleObject. This version actually -// processes messages in the queue instead of blocking them. -// -//*************************************************************************************** -function TXcpTransport.MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; -var - dwEnd:DWord; -begin - // compute the time when the WaitForSingleObject is supposed to time out - dwEnd := GetTickCount + dwMilliseconds; - - repeat - // wait for an event to happen or a message to be in the queue - result := MsgWaitForMultipleObjects(1, hHandle, False, dwMilliseconds, QS_ALLINPUT); - - // a message was in the queue? - if result = WAIT_OBJECT_0 + 1 then - begin - // process these messages - Application.ProcessMessages; - - // check for timeout manually because if a message in the queue occurred, the - // MsgWaitForMultipleObjects will be called again and the timer will start from - // scratch. we need to make sure the correct timeout time is used. - dwMilliseconds := GetTickCount; - if dwMilliseconds < dwEnd then - begin - dwMilliseconds := dwEnd - dwMilliseconds; - end - else - begin - // timeout occured - result := WAIT_TIMEOUT; - Break; - end; - end - else - // the event occured? - begin - // we can stop - Break; - end; - until True = False; -end; //*** end of MsgWaitForSingleObject *** - + result := Word(hardware) + channel; +end; //*** end of ConstructPeakHandle *** end. //******************************** end of XcpTransport.pas ****************************** diff --git a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.cfg b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.cfg deleted file mode 100644 index d2841ff5..00000000 --- a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.cfg +++ /dev/null @@ -1,35 +0,0 @@ --$A+ --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I+ --$J+ --$K- --$L+ --$M- --$N+ --$O+ --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E../../../../../ --LNc:\borland\delphi4\Lib diff --git a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dof b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dof deleted file mode 100644 index 12f6b2c7..00000000 --- a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dof +++ /dev/null @@ -1,88 +0,0 @@ -[Compiler] -A=1 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=1 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=../../../../../ -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40 -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1031 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[Excluded Packages] -$(DELPHI)\Lib\dclusr40.bpl=Borland User -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlOutputDirectorry] -Count=3 -Item0=../../../../../ -Item1=../../../../ -Item2=../../../ diff --git a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr index 470531b8..aeb81d0f 100644 --- a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr +++ b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dpr @@ -51,9 +51,7 @@ uses XcpLoader in '..\..\XcpLoader.pas', XcpTransport in 'XcpTransport.pas', XcpSettings in 'XcpSettings.pas' {XcpSettingsForm}, - pcan_usb in 'Pcan_usb.pas', - PCANdrvD in 'PCANdrvD.pas'; - + PCANBasic in 'PCANBasic.pas'; //*************************************************************************************** // Global Constants @@ -225,7 +223,7 @@ begin end; // update the log - MbiCallbackOnLog(logStr); + MbiCallbackOnLog(ShortString(logStr)); // update loop variables len := len - currentWriteCnt; @@ -259,25 +257,25 @@ begin // connect the transport layer MbiCallbackOnInfo('Connecting to the CAN interface.'); - MbiCallbackOnLog('Connecting to the CAN interface. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connecting to the CAN interface. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; if not loader.Connect then begin // update the user info MbiCallbackOnError('Could not connect to CAN interface. Check your configuration.'); - MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+TimeToStr(Time)); + MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+ShortString(TimeToStr(Time))); Exit; end; //---------------- start the programming session -------------------------------------- - MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time))); // try initial connect via XCP. if the user program is able to reactivate the bootloader // it will do so now sessionStartResult := loader.StartProgrammingSession; if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); loader.Disconnect; Exit; @@ -287,11 +285,11 @@ begin begin // update the user info MbiCallbackOnInfo('Could not connect. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // possible that the bootloader is being activated, which means that the target's // CAN controller is being reinitialized. We should not send any data on the CAN - // network for this to finish. 200ms should do it. not that the backdoor entry time + // network for this to finish. 200ms should do it. note that the backdoor entry time // should be at least 2.5x this. Sleep(200); // continuously try to connect via XCP true the backdoor @@ -301,17 +299,17 @@ begin sessionStartResult := loader.StartProgrammingSession; Application.ProcessMessages; Sleep(5); - // if the is in reset of otherwise does not have the CAN controller synchronized to + // if the hardware is in reset or otherwise does not have the CAN controller synchronized to // the CAN bus, we will be generating error frames, possibly leading to a bus off. // check for this if loader.IsComError then begin // bus off state, so try to recover. - MbiCallbackOnLog('Communication error detected. Trying automatic recovery. t='+TimeToStr(Time)); + MbiCallbackOnLog('Communication error detected. Trying automatic recovery. t='+ShortString(TimeToStr(Time))); loader.Disconnect; if not loader.Connect then begin - MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+TimeToStr(Time)); + MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Could not connect to CAN interface. Check your configuration.'); Exit; end; @@ -320,7 +318,7 @@ begin // don't retry if the error was caused by not being able to unprotect the programming resource if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); Exit; end; @@ -335,7 +333,7 @@ begin end; // still here so programming session was started - MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time))); // create the datafile object datafile := TXcpDataFile.Create(progfile); @@ -361,16 +359,16 @@ begin datafile.GetRegionInfo(regionCnt, addr, len); // erase the memory - MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Clearing Memory '+ShortString(Format('addr:0x%x,len:0x%x',[addr,len]))+'. t='+ShortString(TimeToStr(Time))); if not loader.ClearMemory(addr, len) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not clear memory ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not clear memory ('+errorInfo+').'); + MbiCallbackOnLog('Could not clear memory ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not clear memory ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Memory cleared. t='+TimeToStr(Time)); + MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time))); end; //---------------- next program the memory regions ------------------------------------ @@ -394,18 +392,18 @@ begin if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen; // program the data - MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming Data '+ShortString(Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt]))+'. t='+ShortString(TimeToStr(Time))); LogData(@progdata[bufferOffset], currentWriteCnt); if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not program data ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not program data ('+errorInfo+').'); + MbiCallbackOnLog('Could not program data ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not program data ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Data Programmed. t='+TimeToStr(Time)); + MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time))); // update progress progress := progress + currentWriteCnt; @@ -417,28 +415,28 @@ begin bufferOffset := bufferOffset + currentWriteCnt; // update the user info - MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])); + MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]))); end; end; //---------------- stop the programming session --------------------------------------- - MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Stopping the programming session. t='+ShortString(TimeToStr(Time))); if not loader.StopProgrammingSession then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not stop the programming session ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not stop the programming session ('+errorInfo+').'); + MbiCallbackOnLog('Could not stop the programming session ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not stop the programming session ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Programming session stopped. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time))); // all done so set progress to 100% and finish up progress := datafile.GetDataCnt; datafile.Free; MbiCallbackOnProgress(progress); - MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time)); + MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time))); MbiCallbackOnDone; end; //*** end of OnTimeout *** @@ -502,7 +500,7 @@ begin timer.Enabled := True; // store the program's filename - progfile := fileName; + progfile := String(fileName); end; //*** end of MbiStart *** @@ -520,7 +518,7 @@ begin stopRequest := true; // disconnect the transport layer - MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time)); + MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time))); loader.Disconnect; end; //*** end of MbiStop *** @@ -639,15 +637,15 @@ end; //*** end of MbiConfigure *** //*************************************************************************************** exports //--- begin of don't change --- - MbiInit index 1, - MbiStart index 2, - MbiStop index 3, - MbiDeInit index 4, - MbiName index 5, - MbiDescription index 6, - MbiVersion index 7, - MbiConfigure index 8, - MbiVInterface index 9; + MbiInit, + MbiStart, + MbiStop, + MbiDeInit, + MbiName, + MbiDescription, + MbiVersion, + MbiConfigure, + MbiVInterface; //--- end of don't change --- end. diff --git a/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj new file mode 100644 index 00000000..484f6e54 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/can/peak/openblt_can_peak.dproj @@ -0,0 +1,120 @@ + + + {C587575B-3E1C-4EA4-BB4F-912B83127DCE} + openblt_can_peak.dpr + True + Debug + 1 + Library + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + ../../../../../ + openblt_can_peak + 1 + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + 00400000 + 1 + false + false + false + true + Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage) + true + 1031 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + 1 + false + + + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + 1033 + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + true + DEBUG;$(DCC_Define) + false + + + C:\Work\software\OpenBLT\Host\MicroBoot.exe + true + (None) + 1033 + + + + MainSource + + + + + + + +
XcpSettingsForm
+ + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + openblt_can_peak.dpr + + + + True + + + 12 + + + + diff --git a/Host/Source/MicroBoot/interfaces/can/vector/CANIcon.bmp b/Host/Source/MicroBoot/interfaces/can/vector/CANIcon.bmp deleted file mode 100644 index 6ca58cdf..00000000 Binary files a/Host/Source/MicroBoot/interfaces/can/vector/CANIcon.bmp and /dev/null differ diff --git a/Host/Source/MicroBoot/interfaces/can/vector/CANdrvD.pas b/Host/Source/MicroBoot/interfaces/can/vector/CANdrvD.pas deleted file mode 100644 index 9e508c30..00000000 --- a/Host/Source/MicroBoot/interfaces/can/vector/CANdrvD.pas +++ /dev/null @@ -1,754 +0,0 @@ -unit CANdrvD; -//*************************************************************************************** -// Project Name: TCanDriver component for Borland Delphi -// Description: Encapsulates Vector's CANlib v4.3 into a VCL component -// File Name: CANdrvD.pas -// -//--------------------------------------------------------------------------------------- -// C O P Y R I G H T -//--------------------------------------------------------------------------------------- -// Copyright (c) 2011 by Feaser http://www.feaser.com All rights reserved -// -// This software has been carefully tested, but is not guaranteed for any particular -// purpose. The author does not offer any warranties and does not guarantee the accuracy, -// adequacy, or completeness of the software and is not responsible for any errors or -// omissions or the results obtained from use of the software. -// -//--------------------------------------------------------------------------------------- -// L I C E N S E -//--------------------------------------------------------------------------------------- -// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or -// modify it under the terms of the GNU General Public License as published by the Free -// Software Foundation, either version 3 of the License, or (at your option) any later -// version. -// -// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; -// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -// PURPOSE. See the GNU General Public License for more details. -// -// You have received a copy of the GNU General Public License along with OpenBLT. It -// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. -// -//*************************************************************************************** -interface - - -//*************************************************************************************** -// Includes -//*************************************************************************************** -uses - Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, CANlibD; - - -//*************************************************************************************** -// Type Definitions -//*************************************************************************************** -type - TChannel = ( channel0, channel1 ); - THardware = ( Virtual, CANcardX, CANcardXL, CANcaseXL, CANboardXL, - CANboardXL_Compact, CANac2, CANac2Pci, CANpari, CANdongle, - CANcard, CANcardY, CANcard2, EDICcard ); - TDirection = ( Tx, Rx ); - TCanMsg = packed record - id : LongInt; - dlc : Byte; - data : array [0..MAX_MSG_LEN-1] of Byte; - time : LongInt; - ext : Boolean; - end; - -type - TMessageEvent = procedure( Sender: TObject; Direction: TDirection; Message: TCanMsg ) of object; - TErrorFrameEvent = procedure( Sender: TObject; time: LongInt ) of object; - TBusOffEvent = procedure( Sender: TObject; time: LongInt ) of object; - -type - TCanEventThread = class(TThread) - private - { Private declarations } - FMethod: TThreadMethod; - protected - FEventHndl: LongInt; - procedure Execute; override; - public - property Method : TThreadMethod read FMethod write FMethod; - property EventHandle: LongInt read FEventHndl write FEventHndl; - end; - -type - TCanDriver = class(TComponent) - private - { Private declarations } - FPortHandle : VPortHandle; - FChannelMask : Vaccess; - FPermissionMask: Vaccess; - FCanEventThread: TCanEventThread; - FThreadRunning : boolean; - FEventHandle : LongInt; - FBusOffPending : Boolean; - function IsThreadRunning: boolean; - procedure ProcessEvents; - procedure CopyMessage(event: Vevent; var msg: TCanMsg); - protected - { Protected declarations } - FBaudRate : LongInt; - FChannel : TChannel; - FHardware : THardware; - FFilterMask : LongInt; - FFilterCode : LongInt; - FPriority : TThreadPriority; - FExtendedId : Boolean; - FOnMessage : TMessageEvent; - FOnErrorFrame: TErrorFrameEvent; - FOnBusOff : TBusOffEvent; - procedure SetBaudRate( Value: LongInt ); - procedure SetChannel( Value: TChannel ); - procedure SetHardware( Value: THardware ); - procedure SetFilterMask( Value: LongInt ); - procedure SetFilterCode( Value: LongInt ); - procedure SetPriority( Value: TThreadPriority ); - procedure SetExtendedId( Value: Boolean ); - public - { Public declarations } - constructor Create( AOwner: TComponent ); override; - destructor Destroy; override; - function Connect: boolean; virtual; - procedure Disconnect; virtual; - function Transmit( Message: TCanMsg): boolean; virtual; - function IsConnected: boolean; virtual; - function IsComError: boolean; virtual; - published - { Published declarations } - property BaudRate : LongInt read FBaudRate write SetBaudRate default 500000; - property Channel : TChannel read FChannel write SetChannel default channel0; - property Hardware : THardware read FHardware write SetHardware default Virtual; - property FilterMask : LongInt read FFilterMask write SetFilterMask default 0; - property FilterCode : LongInt read FFilterCode write SetFilterCode default 0; - property Priority : TThreadPriority read FPriority write SetPriority default tpNormal; - property ExtendedId : Boolean read FExtendedId write SetExtendedId default False; - property OnMessage : TMessageEvent read FOnMessage write FOnMessage; - property OnErrorFrame: TErrorFrameEvent read FOnErrorFrame write FOnErrorFrame; - property OnBusOff : TBusOffEvent read FOnBusOff write FOnBusOff; - end; - - -//*************************************************************************************** -// Prototypes -//*************************************************************************************** -procedure Register; - -implementation -//*************************************************************************************** -// Constants -//*************************************************************************************** -const - Channels: array[channel0..channel1] of integer = ( 0, 1 ); - HardwareTypes: array[Virtual..EDICcard] of integer = ( - HWTYPE_VIRTUAL, HWTYPE_CANCARDX, HWTYPE_CANCARDXL, HWTYPE_CANCASEXL, HWTYPE_CANBOARDXL, - HWTYPE_CANBOARDXL_COMPACT, HWTYPE_CANAC2, HWTYPE_CANAC2PCI, HWTYPE_CANPARI, - HWTYPE_CANDONGLE, HWTYPE_CANCARD, HWTYPE_CANCARDY, HWTYPE_CANCARD2, HWTYPE_EDICCARD); - - -//*************************************************************************************** -// NAME: Execute -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Overriden Execute function for the CanEventThread. Calls and synchro- -// nizes with the TCanDriver.ProcessEvents function. -// -//*************************************************************************************** -procedure TCanEventThread.Execute; -begin - while not Terminated do - begin - if FEventHndl <> 0 then // make sure event is configured - begin - // wait for receive event - WaitForSingleObject(FEventHndl, 1000); - - if Assigned(Method) then // make sure TCanDriver.ProcessEvents is set - Synchronize(Method); // call and synchronize - end; - end; -end; //*** end of Execute *** - - -//*************************************************************************************** -// NAME: Create -// PRECONDITIONS: none -// PARAMETER: AOwner : owner of the component -// RETURN VALUE: none -// DESCRIPTION: Component constructor. Calls TComponent's constructor and initializes -// the private property variables to their default values. -// -//*************************************************************************************** -constructor TCanDriver.Create( AOwner: TComponent ); -begin - // call inherited constructor - inherited Create( AOwner ); - - // set defaults for internal variables - FPortHandle := INVALID_PORTHANDLE; - FChannelMask := 0; - FPermissionMask:= 0; - FThreadRunning := False; - FEventHandle := 0; - FBusOffPending := False; - - // set defaults for properties - FBaudRate := 500000; - FChannel := channel0; - FHardware := Virtual; - FFilterMask := 0; - FFilterCode := 0; - FPriority := tpNormal; - FExtendedId := False; -end; //*** end of Create *** - - -//*************************************************************************************** -// NAME: Destroy -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Component destructor. Calls TComponent's destructor -// -//*************************************************************************************** -destructor TCanDriver.Destroy; -begin - Disconnect; // close the port and driver - inherited Destroy; // call inherited destructor -end; //*** end of Destroy *** - - -//*************************************************************************************** -// NAME: IsConnected -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: True or False -// DESCRIPTION: Determines whether or not the CAN driver is connected and active -// -//*************************************************************************************** -function TCanDriver.IsConnected: boolean; -begin - if FPortHandle <> INVALID_PORTHANDLE then - Result := True - else - Result := False; -end; //*** end of IsConnected *** - - -//*************************************************************************************** -// NAME: IsComError -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: True if the communication interface is in error state, False otherwise -// DESCRIPTION: Determines whether or not the CAN controller is in error state. -// -//*************************************************************************************** -function TCanDriver.IsComError: boolean; -begin - result := FBusOffPending; -end; //*** end of IsComError *** - - -//*************************************************************************************** -// NAME: IsThreadRunning -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: True or False -// DESCRIPTION: Determines whether or not the CAN event thread is running -// -//*************************************************************************************** -function TCanDriver.IsThreadRunning: boolean; -begin - if FThreadRunning = True then - Result := True - else - Result := False; -end; //*** end of IsThreadRunning *** - - -//*************************************************************************************** -// NAME: CopyMessage -// PRECONDITIONS: none -// PARAMETER: event: msg tx or rx event information (source) -// msg: buffer to copy message to (destination) -// RETURN VALUE: none -// DESCRIPTION: Copies a CAN message from an event type to a TCanMsg type. -// -//*************************************************************************************** -procedure TCanDriver.CopyMessage(event: Vevent; var msg: TCanMsg); -var - cnt: integer; -begin - if (event.msg.id and EXT_MSG) = EXT_MSG then // 29-bit id? - begin - msg.id := (event.msg.id and not EXT_MSG); // reset ext bit - msg.ext := True; // this is an 29-bit id - end - else - begin - msg.id := event.msg.id; // store id - msg.ext := False; // this is an 11-bit id - end; - msg.dlc := event.msg.dlc; - msg.time := event.timeStamp; - - // copy the data bytes - for cnt :=0 to MAX_MSG_LEN-1 do - begin - if cnt < event.msg.dlc then - msg.data[cnt] := event.msg.data[cnt] - else - msg.data[cnt] := 0; - end; -end; //*** end of CopyMessage *** - - -//*************************************************************************************** -// NAME: SetBaudRate -// PRECONDITIONS: none -// PARAMETER: Value : new baudrate value [0 - 1000000 bps] -// RETURN VALUE: none -// DESCRIPTION: Configures the baudrate -// -// |------------------------------------------------------------------------------------ -// | Update baudrate configuration -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetBaudRate( Value: LongInt ); -begin - FBaudRate := Value; // update property -end; //*** end of SetBaudRate *** - - -//*************************************************************************************** -// NAME: SetChannel -// PRECONDITIONS: none -// PARAMETER: Value : channel0 or channel1 -// RETURN VALUE: none -// DESCRIPTION: Configures the used CAN channel -// -// |------------------------------------------------------------------------------------ -// | Update channel configuration -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetChannel( Value: TChannel ); -begin - FChannel := Value; -end; //*** end of SetChannel *** - - -//*************************************************************************************** -// NAME: SetHardware -// PRECONDITIONS: none -// PARAMETER: Value : type of CAN hardware (Virtual, CANcardXL, etc.) -// RETURN VALUE: none -// DESCRIPTION: Configures the used CAN hardware -// -// |------------------------------------------------------------------------------------ -// | Update hardware configuration -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetHardware( Value: THardware ); -begin - FHardware := Value; -end; //*** end of SetHardware *** - - -//*************************************************************************************** -// NAME: SetFilterMask -// PRECONDITIONS: none -// PARAMETER: Value : acceptance filter mask -// RETURN VALUE: none -// DESCRIPTION: Configures the acceptance filter mask for the CAN channel -// -// |------------------------------------------------------------------------------------ -// | Update filter mask value -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetFilterMask( Value: LongInt ); -begin - FFilterMask := Value; -end; //*** end of SetFilterMask *** - - -//*************************************************************************************** -// NAME: SetFilterCode -// PRECONDITIONS: none -// PARAMETER: Value : acceptance filter code -// RETURN VALUE: none -// DESCRIPTION: Configures the acceptance filter code for the CAN channel -// -// |------------------------------------------------------------------------------------ -// | Update filter code value -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetFilterCode( Value: LongInt ); -begin - FFilterCode := Value; -end; //*** end of SetFilterCode *** - - -//*************************************************************************************** -// NAME: SetPriority -// PRECONDITIONS: none -// PARAMETER: Value : thread priority -// RETURN VALUE: none -// DESCRIPTION: Configures the priority for the CAN event thread -// -// |------------------------------------------------------------------------------------ -// | y\ Is Thread running? /n -// |------------------------------------------------------------------------------------ -// | Stop Thread | -// | Update Thread priority | Update Thread priority -// | Restart Thread | -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetPriority( Value: TThreadPriority ); -begin - if IsThreadRunning then - begin - FCanEventThread.Suspend; // suspend the thread - FPriority := Value; // update the priority - FCanEventThread.Resume; // resume the thread - end - else - begin - FPriority := Value; // update the priority - end; -end; //*** end of SetPriority *** - - -//*************************************************************************************** -// NAME: SetExtendedId -// PRECONDITIONS: none -// PARAMETER: Value : true = support only 29-bit id's, false = support only 11-bit -// RETURN VALUE: none -// DESCRIPTION: Configures the support of extended 29-bit identifiers -// -// |------------------------------------------------------------------------------------ -// | Update extended id support selection -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.SetExtendedId( Value: Boolean ); -begin - FExtendedId := Value; -end; //*** end of SetExtendedId ***/ - - -//*************************************************************************************** -// NAME: Connect -// PRECONDITIONS: Disconnected from CAN bus -// PARAMETER: none -// RETURN VALUE: True or False for succees or error, respectively -// DESCRIPTION: Initializes the CAN driver and synchronizes the hardware with the CAN -// bus. -// -// |------------------------------------------------------------------------------------ -// | y\ Connected? /n -// |------------------------------------------------------------------------------------ -// | Open the driver (ncdOpenDriver) -// | Obtain mask to channel (ncdGetChannelMask) -// | Open the port using this mask (ncdOpenPort) -// |------------------------------------------------------------------------------------ -// | y\ Permission to change settings? /n -// |------------------------------------------------------------------------------------ -// | Configure baudrate (ncdSetChannelBitrate) | -// |------------------------------------------------------------------------------------ -// | Configure acceptance filter (ncdSetChannelAcceptance) -// | Enable error frames and chipstate events (ncdSetReceiveMode) -// | Create synchronizatio object (ncdSetNotification) -// | Reset internal clock (ncdResetClock) -// | Sync to the CAN bus (ncdActivateChannel) -// | Empty transmit and receive queue's (ncdFlushXxxQueue) -// |------------------------------------------------------------------------------------ -// | y\ Errors occurred during init? /n -// |------------------------------------------------------------------------------------ -// | y\ Port opened? /n | -// |-------------------------------------------------------------| Start CAN event thread -// | Close port (ncdClosePort) | | Return TRUE -// |-------------------------------------------------------------| -// | Return FALSE | -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -function TCanDriver.Connect: boolean; -var - vErr : Vstatus; - acc : VsetAcceptance; -label - error; -begin - // reset internal variables - FPortHandle := INVALID_PORTHANDLE; - FChannelMask := 0; - FPermissionMask:= 0; - FThreadRunning := False; - FEventHandle := 0; - FBusOffPending := False; - - //-------------------------- open the driver ------------------------------------------ - vErr := ncdOpenDriver; - if vErr <> VSUCCESS then goto error; - - //-------------------------- select a channel ----------------------------------------- - FChannelMask := ncdGetChannelMask(HardwareTypes[FHardware], 0, Channels[FChannel]); - if FChannelMask=0 then goto error; - - //-------------------------- open a port ---------------------------------------------- - FPermissionMask := FChannelMask; - vErr := ncdOpenPort(FPortHandle, 'TCanDriver0', FChannelMask, FPermissionMask, - FPermissionMask, 1024); - if vErr <> VSUCCESS then goto error; - - //-------------------------- set baudrate --------------------------------------------- - if FPermissionMask<>0 then - begin - vErr := ncdSetChannelBitrate(FPortHandle, FPermissionMask, FBaudRate); - if vErr <> VSUCCESS then goto error; - end; - - //-------------------------- set the acceptance filter -------------------------------- - acc.mask := FFilterMask; - acc.code := FFilterCode; - if FExtendedId = True then // 29-bit id used? - begin - acc.mask := acc.mask or LongInt(EXT_MSG); - acc.code := acc.code or LongInt(EXT_MSG); - end; - vErr := ncdSetChannelAcceptance(FPortHandle, FChannelMask, acc); - if vErr <> VSUCCESS then goto error; - - //-------------------------- enable error frames and chipstate events ----------------- - vErr := ncdSetReceiveMode(FPortHandle, 0, 0); - if vErr <> VSUCCESS then goto error; - - //-------------------------- create synchronisation object ---------------------------- - FEventHandle := CreateEvent(nil, FALSE, FALSE, nil); - if FEventHandle = 0 then goto error; - vErr := ncdSetNotification(FPortHandle, FEventHandle, 1); - if vErr<>VSUCCESS then goto error; - - //-------------------------- reset the clock ------------------------------------------ - vErr := ncdResetClock(FPortHandle); - if vErr <> VSUCCESS then goto error; - - //-------------------------- sync with bus -------------------------------------------- - vErr := ncdActivateChannel(FPortHandle, FChannelMask); - if vErr <> VSUCCESS then goto error; - - //-------------------------- flush queue's -------------------------------------------- - vErr := ncdFlushReceiveQueue(FPortHandle); - if vErr <> VSUCCESS then goto error; - vErr := ncdFlushTransmitQueue(FPortHandle, FChannelMask); - if vErr <> VSUCCESS then goto error; - - //-------------------------- start CAN event thread ----------------------------------- - FCanEventThread := TCanEventThread.Create(True); // create and suspend - FCanEventThread.FreeOnTerminate := True; // auto free on termination - FCanEventThread.Method := ProcessEvents; // set method - FCanEventThread.FEventHndl := FEventHandle; // set event handle - FCanEventThread.Resume; // start - FThreadRunning := True; - - //-------------------------- success -------------------------------------------------- - Result := True; // successfully initialized the driver - exit; // stop here - - //-------------------------- error occurred ------------------------------------------- - error: - if FEventHandle <> 0 then - CloseHandle(FEventHandle); - if FPortHandle <> INVALID_PORTHANDLE then - begin - ncdClosePort(FPortHandle); - FPortHandle := INVALID_PORTHANDLE; - end; - Result := False; -end; //*** end of Connect *** - - -//*************************************************************************************** -// NAME: Disconnect -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Disconnects the CAN driver -// -// |------------------------------------------------------------------------------------ -// | y\ Connected? /n -// |------------------------------------------------------------------------------------ -// | Deactivate the channel (ncdDeactivateChannel) | -// | Close port (ncdClosePort) | -// |------------------------------------------------------------------------------------ -// | Close the driver (ncdCloseDriver) -// |------------------------------------------------------------------------------------ -// | y\ CAN event thread active? /n -// |------------------------------------------------------------------------------------ -// | Stop CAN event thread | -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -procedure TCanDriver.Disconnect; -begin - if IsConnected = True then begin // are we connected? - ncdDeactivateChannel(FPortHandle, FChannelMask); // deactivate channel - if FEventHandle <> 0 then - CloseHandle(FEventHandle); - ncdClosePort(FPortHandle); // close the port - FPortHandle := INVALID_PORTHANDLE; // invalidate handle - end; - ncdCloseDriver; // close the driver - if IsThreadRunning then - begin - FCanEventThread.FEventHndl := 0; // reset event handle - FCanEventThread.Terminate; // stop - FThreadRunning := False; - end; -end; //*** end of Disconnect *** - - -//*************************************************************************************** -// NAME: Transmit -// PRECONDITIONS: Driver initialized using 'Connect' -// PARAMETER: Message: CAN message that is to be transmitted -// RETURN VALUE: True or False for succees or error, respectively -// DESCRIPTION: Transmits a CAN message. -// -// |------------------------------------------------------------------------------------ -// | y\ Connected? /n -// |------------------------------------------------------------------------------------ -// | Transmit message using ncdTransmit | -// |----------------------------------------------| Return FALSE -// | Return TRUE | -// |------------------------------------------------------------------------------------ -//*************************************************************************************** -function TCanDriver.Transmit( Message: TCanMsg): boolean; -var - vErr : Vstatus; - event : Vevent; - cnt : integer; -begin - // make sure the CAN driver is connected - if not IsConnected then - begin - Result := False; // can't transmit it not connected - exit; // no need to continue - end; - - // configure message as tx with acknowledge - event.tag := V_TRANSMIT_MSG; - event.msg.flags := MSGFLAG_TX; - - // set the message identifier - if Message.ext = True then - event.msg.id := Message.id or LongInt(EXT_MSG) - else - event.msg.id := Message.id; - - // set the data length - event.msg.dlc := Message.dlc; - - // store the data bytes - for cnt :=0 to MAX_MSG_LEN-1 do - begin - event.msg.data[cnt] := Message.data[cnt]; - end; - - vErr := ncdTransmit(FPortHandle, FChannelMask, event); - - if vErr <> VSUCCESS then - Result := False - else - Result := True; -end; //*** end of Transmit *** - - -//*************************************************************************************** -// NAME: ProcessEvents -// PRECONDITIONS: thread running -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Called by the CAN event tread. This function traps and processes CAN -// events for OnMessage, OnBusOff, and OnErrorFrame. -// -//*************************************************************************************** -procedure TCanDriver.ProcessEvents; -var - vErr : Vstatus; - pEvent : PVEvent; - msg : TCanMsg; -begin - while True do - begin - vErr := ncdReceive1(FPortHandle, pEvent); - - if (vErr<>VSUCCESS) and (vErr<>VERR_QUEUE_IS_EMPTY) then break; - if vErr=VERR_QUEUE_IS_EMPTY then break; - - case pEvent^.tag of - V_RECEIVE_MSG, V_TRANSMIT_MSG: - begin - if (pEvent^.msg.flags and MSGFLAG_ERROR_FRAME) = MSGFLAG_ERROR_FRAME then - begin - //---------------- process errorframe ----------------------------------------- - if Assigned( FOnErrorFrame ) then - begin - FOnErrorFrame( Self, pEvent^.timeStamp ); // call application's event handler - end; - end - else if pEvent^.msg.flags = 0 then // msg rx indication - begin - //---------------- process reception indication ------------------------------- - CopyMessage(pEvent^, msg); - if Assigned( FOnMessage ) then - begin - FOnMessage( Self, Rx, msg ); // call application's event handler - end; - end - else if (pEvent^.msg.flags and MSGFLAG_TX) = MSGFLAG_TX then // msg tx confirmation - begin - //---------------- process transmission confirmation -------------------------- - CopyMessage(pEvent^, msg); - if Assigned( FOnMessage ) then - begin - FOnMessage( Self, Tx, msg ); // call application's event handler - end; - end; - end; - V_CHIP_STATE: - begin - if (pEvent^.chipState.busStatus and CHIPSTAT_BUSOFF) = CHIPSTAT_BUSOFF then - begin - //---------------- process bus off event -------------------------------------- - FBusOffPending := True; - if Assigned( FOnBusOff ) then - begin - FOnBusOff( Self, pEvent^.timeStamp ); // call application's event handler - end; - end; - end; - end; - end; -end; //*** end of ProcessEvents *** - - -//*************************************************************************************** -// NAME: Register -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Registers the TCanDriver component into Borland Delphi's IDE. -// -//*************************************************************************************** -procedure Register; -begin - RegisterComponents('Feaser', [TCanDriver]); -end; //*** end of Register *** - - -end. -//********************************** end of CANdrvD.pas ********************************* - - diff --git a/Host/Source/MicroBoot/interfaces/can/vector/CANlibD.pas b/Host/Source/MicroBoot/interfaces/can/vector/CANlibD.pas deleted file mode 100644 index e6e6a3af..00000000 --- a/Host/Source/MicroBoot/interfaces/can/vector/CANlibD.pas +++ /dev/null @@ -1,959 +0,0 @@ -unit CANlibD; - -(*---------------------------------------------------------------------------- -| File: -| CANlibD.pas -| Project: -| Unit for Delphi32 samples (V2.0) -| -|----------------------------------------------------------------------------- -| Ported from cantrace.c by Torsten Lang -|----------------------------------------------------------------------------- -| Copyright (c) 1998 BSK Datentechnik GmbH, Kiesacker 14, 35418 Buseck / -| 1998 by Vector Informatik GmbH, Friolzheimer Str. 6, 70499 Stuttgart -| All rights reserved. -| -| BSK Datentechnik räumt der Vector Informatik GmbH das nicht ausschließliche Recht -| ein, CANlibD.pas für eigene Zwecke zu nutzen. Vector ist es gestattet, die -| Software zu kopieren, abzuändern, zu erweitern, weiterzugeben und in Software von -| Vector zu integrieren. Im Quelltext enthaltene Copyright-Hinweise dürfen hierbei -| nicht entfernt oder geändert werden. -| Vector darf aus von ihm vorgenommenen Anpassungen und/oder Erweiterungen der -| CANlibD.pas keine Rechte an irgendwelchen Teilen der Software gegenüber BSK -| Datentechnik geltend machen. - ----------------------------------------------------------------------------*) - -{ environment switches } -(******************************************************************************* -Attention: -1. All functions that use pointers to structures (either explicitly or by using - var parameters) may change the contents of the structures right after the - funtction returns. -*******************************************************************************) -{$ifdef WIN32} -{$define CanLib4Delphi32} -{$else} -{$ifdef CONSOLE} -{$define CanLib4Delphi32} -{$endif} -{$endif} - -{ public interface } - -interface - -type - ncdStringType = PChar; - Vstatus = Word; - -const - MAX_APPNAME = 32; - - VCAN_WAIT = 0; - VCAN_POLL = 1; - {$ifdef CanLib4Delphi32} - { Attention: This exists only under Win32 } - VCAN_NOTIFY = 2; - {$endif} - - VSUCCESS = 0; - VPENDING = 1; - VERROR = 255; - VERR_QUEUE_IS_EMPTY = 10; - VERR_QUEUE_IS_FULL = 11; - VERR_TX_NOT_POSSIBLE = 12; - VERR_NO_LICENSE = 14; - VERR_WRONG_PARAMETER = 101; - VERR_TWICE_REGISTER = 110; - VERR_INVALID_CHAN_INDEX = 111; - VERR_INVALID_ACCESS = 112; - VERR_PORT_IS_OFFLINE = 113; - VERR_CHAN_IS_ONLINE = 116; - VERR_INVALID_PORT = 118; - VERR_HW_NOT_READY = 120; - VERR_CMD_TIMEOUT = 121; - VERR_HW_NOT_PRESENT = 129; - VERR_NOTIFY_ALREADY_ACTIVE = 131; - VERR_CANNOT_OPEN_DRIVER = 201; - -{ -//------------------------------------------------------------------------------ -// accessmask -} -type - Vaccess = LongInt; { unsigned long doesn't exist for Delphi32 / Borland Pascal 7! } - -{ -//------------------------------------------------------------------------------ -// porthandle -} - -const - INVALID_PORTHANDLE = -1; - -type - VportHandle = LongInt; - -{ -//------------------------------------------------------------------------------ -// acceptance filter -} - -type - VsetAcceptance = packed record - code : LongInt; {unsigned long doesn't exist!} - mask : LongInt; {unsigned long doesn't exist!} - end; - PVsetAcceptance = ^VsetAcceptance; - -{ -//------------------------------------------------------------------------------ -// bit timing -} - -type - VchipParams = packed record - bitRate : LongInt; {unsigned long doesn't exist!} - sjw : Byte; - tseg1 : Byte; - tseg2 : Byte; - sam : Byte; { 1 or 3 } - end; - PVchipParams = ^VchipParams; - -{ -//------------------------------------------------------------------------------ -// definitions for the events and commands used by the driver -} - -const - V_RECEIVE_MSG = 1; - V_CHIP_STATE = 4; - V_CLOCK_OVERFLOW = 5; - V_TRIGGER = 6; - V_TIMER = 8; - V_TRANSCEIVER = 9; - V_TRANSMIT_MSG = 10; - -type - VeventTag = Byte; - -{ -//------------------------------------------------------------------------------ -// events -} - -{ -//------------------------------------------------------------------------------ -// structure for V_RECEIVE_MSG -} - -const - MAX_MSG_LEN = 8; - EXT_MSG = $80000000; { signs an extended identifier } - - MSGFLAG_ERROR_FRAME = $01; { Msg is a bus error } - MSGFLAG_OVERRUN = $02; { Msgs following this has been lost } - MSGFLAG_NERR = $04; { NERR active during this msg } - MSGFLAG_WAKEUP = $08; { Msg rcv'd in wakeup mode } - MSGFLAG_REMOTE_FRAME = $10; { Msg is a remote frame } - MSGFLAG_RESERVED_1 = $20; { Reserved for future usage } - MSGFLAG_TX = $40; { TX acknowledge } - MSGFLAG_TXRQ = $80; { TX request } - -type - _Vmsg = packed record - id : LongInt; {unsigned long doesn't exist!} - flags : Byte; - dlc : Byte; - data : array [0..MAX_MSG_LEN-1] of Byte; - end; { 14 Bytes } - _PVmsg = ^_Vmsg; - -{ -// structure for V_CHIP_STATE -} - -const - CHIPSTAT_BUSOFF = $01; - CHIPSTAT_ERROR_PASSIVE = $02; - CHIPSTAT_ERROR_WARNING = $04; - CHIPSTAT_ERROR_ACTIVE = $08; - -type - _VchipState = packed record - busStatus : Byte; - txErrorCounter : Byte; - rxErrorCounter : Byte; - end; - _PVchipState = ^_VchipState; - -{ -// structure for V_TRANSCEIVER -} - -const - TRANSCEIVER_EVENT_ERROR = 1; - TRANSCEIVER_EVENT_CHANGED = 2; - - TRANSCEIVER_TYPE_NONE = 0; - TRANSCEIVER_TYPE_251 = 1; - TRANSCEIVER_TYPE_252 = 2; - TRANSCEIVER_TYPE_DNOPTO = 3; - TRANSCEIVER_TYPE_W210 = 4; - - TRANSCEIVER_LINEMODE_NA = 0; - TRANSCEIVER_LINEMODE_TWO_LINE = 1; - TRANSCEIVER_LINEMODE_CAN_H = 2; - TRANSCEIVER_LINEMODE_CAN_L = 3; - - TRANSCEIVER_RESNET_NA = 0; - TRANSCEIVER_RESNET_MASTER = 1; - TRANSCEIVER_RESNET_MASTER_STBY = 2; - TRANSCEIVER_RESNET_SLAVE = 3; - -type - _Vtransceiver = packed record - event : Byte; { TRANSCEIVER_EVENT_xxx } - end; - _PVtransceiver = ^_Vtransceiver; - - Vevent = packed record - tag : VeventTag; { 1 } - chanIndex : Byte; { 1 } - _transId : Byte; { 1 not implemented yet !!!! } - portHandle : Byte; { 1 internal use only !!!! } - timeStamp : LongInt; { 4 } { unsigned long doesn't exist! } - case {tagData:}Byte of - 0 : (msg : _Vmsg); - 1 : (chipState : _VchipState); - 2 : (transceiver : _Vtransceiver); - { 14 Bytes (_VMessage) } - end; - { -------- } - { 22 Bytes } - PVevent = ^Vevent; - -{ -//------------------------------------------------------------------------------ -// structure for SET_OUTPUT_MODE -} - -const - OUTPUT_MODE_SILENT = 0; - OUTPUT_MODE_NORMAL = 1; - -{ -//------------------------------------------------------------------------------ -// configuration -} - -{ -// defines for the supported hardware -} -const - HWTYPE_NONE = 0; - HWTYPE_VIRTUAL = 1; - HWTYPE_CANCARDX = 2; - HWTYPE_CANPARI = 3; - HWTYPE_CANDONGLE = 4; - HWTYPE_CANAC2 = 5; - HWTYPE_CANAC2PCI = 6; - HWTYPE_CANCARD = 7; - HWTYPE_CANCARDY = 12; - HWTYPE_CANCARDXL = 15; - HWTYPE_CANCARD2 = 17; - HWTYPE_EDICCARD = 19; - HWTYPE_CANCASEXL = 21; - HWTYPE_CANBOARDXL = 25; - HWTYPE_CANBOARDXL_COMPACT = 27; - MAX_HWTYPE = 27; - -{ -// defines for the tranceiver type -} -const - (* - TRANSCEIVER_TYPE_NONE = 0; - TRANSCEIVER_TYPE_251 = 1; - TRANSCEIVER_TYPE_252 = 2; - TRANSCEIVER_TYPE_DNOPTO = 3; - TRANSCEIVER_TYPE_W210 = 4; - *) { These have already been defined above } - MAX_TRANSCEIVER_TYPE = 4; - - MAX_CHAN_NAME = 31; - MAX_DRIVER_NAME = 31; - -type - VChannelConfig = packed record - name : array [0..MAX_CHAN_NAME] of Char; - hwType : Byte; { HWTYPE_xxxx (see above) } - hwIndex : Byte; { Index of the hardware (same type) (0,1,...) } - hwChannel : Byte; { Index of the channel (same hardware) (0,1,...) } - tranceiverType : Byte; { TRANCEIVER_TYPE_xxxx (see above) } - channelIndex : Byte; { Global channel index (0,1,...) } - channelMask : LongInt; { Global channel mask (=1< '' then - begin - // create ini file object - settingsIni := TIniFile.Create(FIniFile); - - // CAN related elements - settingsIni.WriteInteger('can', 'hardware', FSettingsForm.cmbHardware.ItemIndex); - settingsIni.WriteInteger('can', 'channel', FSettingsForm.cmbChannel.ItemIndex); - settingsIni.WriteInteger('can', 'baudrate', StrToInt(FSettingsForm.edtBaudRate.Text)); - settingsIni.WriteBool('can', 'extended', FSettingsForm.chbExtendedId.Checked); - settingsIni.WriteInteger('can', 'txid', StrToInt('$'+FSettingsForm.edtTransmitId.Text)); - settingsIni.WriteInteger('can', 'rxid', StrToInt('$'+FSettingsForm.edtReceiveId.Text)); - - // XCP related elements - settingsIni.WriteString('xcp', 'seedkey', FSettingsForm.edtSeedKey.Text); - settingsIni.WriteInteger('xcp', 't1', StrToInt(FSettingsForm.edtT1.Text)); - settingsIni.WriteInteger('xcp', 't3', StrToInt(FSettingsForm.edtT3.Text)); - settingsIni.WriteInteger('xcp', 't4', StrToInt(FSettingsForm.edtT4.Text)); - settingsIni.WriteInteger('xcp', 't5', StrToInt(FSettingsForm.edtT5.Text)); - settingsIni.WriteInteger('xcp', 't7', StrToInt(FSettingsForm.edtT7.Text)); - settingsIni.WriteInteger('xcp', 'tconnect', StrToInt(FSettingsForm.edtTconnect.Text)); - - // release ini file object - settingsIni.Free; - - // indicate that the settings where successfully updated - result := true; - end; - end; -end; //*** end of Configure *** - - -end. -//******************************** end of XcpSettings.pas ******************************* - - diff --git a/Host/Source/MicroBoot/interfaces/can/vector/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/can/vector/XcpTransport.pas deleted file mode 100644 index e144075f..00000000 --- a/Host/Source/MicroBoot/interfaces/can/vector/XcpTransport.pas +++ /dev/null @@ -1,414 +0,0 @@ -unit XcpTransport; -//*************************************************************************************** -// Description: XCP transport layer for CAN. -// File Name: XcpTransport.pas -// -//--------------------------------------------------------------------------------------- -// C O P Y R I G H T -//--------------------------------------------------------------------------------------- -// Copyright (c) 2011 by Feaser http://www.feaser.com All rights reserved -// -// This software has been carefully tested, but is not guaranteed for any particular -// purpose. The author does not offer any warranties and does not guarantee the accuracy, -// adequacy, or completeness of the software and is not responsible for any errors or -// omissions or the results obtained from use of the software. -// -//--------------------------------------------------------------------------------------- -// L I C E N S E -//--------------------------------------------------------------------------------------- -// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or -// modify it under the terms of the GNU General Public License as published by the Free -// Software Foundation, either version 3 of the License, or (at your option) any later -// version. -// -// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; -// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -// PURPOSE. See the GNU General Public License for more details. -// -// You have received a copy of the GNU General Public License along with OpenBLT. It -// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. -// -//*************************************************************************************** -interface - - -//*************************************************************************************** -// Includes -//*************************************************************************************** -uses - Windows, Messages, SysUtils, Classes, Forms, CANdrvD, IniFiles; - - -//*************************************************************************************** -// Global Constants -//*************************************************************************************** -const kMaxPacketSize = 256; - - -//*************************************************************************************** -// Type Definitions -//*************************************************************************************** -type - TXcpTransportInfo = (kNone, kResponse, kError); - - -type - TXcpTransport = class(TObject) - private - comEventInfo : TXcpTransportInfo; - comEvent : THandle; - packetTxId : LongWord; - packetRxId : Longword; - extendedId : Boolean; - procedure OnCanMessage(Sender: TObject; Direction: TDirection; Message: TCanMsg); - procedure OnBusOff(Sender: TObject; time: LongInt); - function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; - public - packetData : array[0..kMaxPacketSize-1] of Byte; - packetLen : Word; - canDriver : TCanDriver; - constructor Create; - procedure Configure(iniFile : string); - function Connect: Boolean; - function SendPacket(timeOutms: LongWord): Boolean; - function IsComError: Boolean; - procedure Disconnect; - destructor Destroy; override; - end; - - -implementation - -//*************************************************************************************** -// NAME: Create -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Class constructore -// -//*************************************************************************************** -constructor TXcpTransport.Create; -begin - // call inherited constructor - inherited Create; - - // reset can event info - comEventInfo := kNone; - - // create the event that requires manual reset - comEvent := CreateEvent(nil, True, False, nil); - - if comEvent = 0 then - Application.MessageBox( 'Could not obtain event placeholder.', - 'Error', MB_OK or MB_ICONERROR ); - - // create a can driver instance - canDriver := TCanDriver.Create(nil); - - // set can driver event handlers - canDriver.OnMessage := OnCanMessage; - canDriver.OnBusOff := OnBusOff; - - - // reset the packet ids - packetTxId := 0; - packetRxId := 0; - - // use standard id's by default - extendedId := false; - - // reset packet length - packetLen := 0; -end; //*** end of Create *** - - -//*************************************************************************************** -// NAME: Destroy -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Class destructor -// -//*************************************************************************************** -destructor TXcpTransport.Destroy; -begin - // release can driver instances - canDriver.Free; - - // release event handle - CloseHandle(comEvent); - - // call inherited destructor - inherited; -end; //*** end of Destroy *** - - -//*************************************************************************************** -// NAME: Configure -// PARAMETER: filename of the INI -// RETURN VALUE: none -// DESCRIPTION: Configures both this class from the settings in the INI. -// -//*************************************************************************************** -procedure TXcpTransport.Configure(iniFile : string); -var - settingsIni : TIniFile; - hwIndex : integer; -begin - // read XCP configuration from INI - if FileExists(iniFile) then - begin - // create ini file object - settingsIni := TIniFile.Create(iniFile); - - // set message configuration - packetTxId := settingsIni.ReadInteger('can', 'txid', $667); - packetRxId := settingsIni.ReadInteger('can', 'rxid', $7e1); - extendedId := settingsIni.ReadBool('can', 'extended', false); - - // configure can hardware - hwIndex := settingsIni.ReadInteger('can', 'hardware', 0); - canDriver.Hardware := Virtual; // init to virtual channel - case hwIndex of - 0 : canDriver.Hardware := Virtual; - 1 : canDriver.Hardware := CANcardX; - 2 : canDriver.Hardware := CANcardXL; - 3 : canDriver.Hardware := CANcaseXL; - 4 : canDriver.Hardware := CANboardXL; - 5 : canDriver.Hardware := CANboardXL_Compact; - 6 : canDriver.Hardware := CANac2; - 7 : canDriver.Hardware := CANac2Pci; - 8 : canDriver.Hardware := CANpari; - 9 : canDriver.Hardware := CANdongle; - 10: canDriver.Hardware := CANcard; - 11: canDriver.Hardware := CANcardY; - 12: canDriver.Hardware := CANcard2; - 13: canDriver.Hardware := EDICcard; - end; - - // configure baudrate - canDriver.BaudRate := settingsIni.ReadInteger('can', 'baudrate', 500) * 1000; - - if settingsIni.ReadInteger('can', 'channel', 0) = 0 then - canDriver.Channel := channel0 - else - canDriver.Channel := channel1; - - // release ini file object - settingsIni.Free; - end; -end; //*** end of Configure *** - - -//*************************************************************************************** -// NAME: Connect -// PARAMETER: none -// RETURN VALUE: True if successful, False otherwise. -// DESCRIPTION: Connects the transport layer device. -// -//*************************************************************************************** -function TXcpTransport.Connect: Boolean; -begin - result := true; - if not canDriver.Connect then - result := false; -end; //*** end of Connect *** - - -//*************************************************************************************** -// NAME: IsComError -// PARAMETER: none -// RETURN VALUE: True if in error state, False otherwise. -// DESCRIPTION: Determines if the communication interface is in an error state. -// -//*************************************************************************************** -function TXcpTransport.IsComError: Boolean; -begin - result := canDriver.IsComError; -end; //*** end of IsComError *** - - -//*************************************************************************************** -// NAME: SendPacket -// PARAMETER: the time[ms] allowed for the reponse from the slave to come in. -// RETURN VALUE: True if response received from slave, False otherwise -// DESCRIPTION: Sends the XCP packet using the data in 'packetData' and length in -// 'packetLen' and waits for the response to come in. -// -//*************************************************************************************** -function TXcpTransport.SendPacket(timeOutms: LongWord): Boolean; -var - msg: TCanMsg; - cnt : byte; - waitResult: Integer; -begin - // do not send any more data on the network when we are in bus off state. - if IsComError then - begin - result := false; - Exit; - end; - - // prepare the packet - msg.id := LongInt(PacketTxId); - msg.dlc := packetLen; - msg.ext := extendedId; - for cnt := 0 to packetLen-1 do - begin - msg.data[cnt] := packetData[cnt]; - end; - - // make sure the event is reset - ResetEvent(comEvent); - comEventInfo := kNone; - - // submit the packet transmission request - if not canDriver.Transmit(msg) then - begin - // unable to submit tx request - result := False; - Exit; - end; - - // packet is being transmitted. Now wait for the response to come in - waitResult := MsgWaitForSingleObject(comEvent, timeOutms); - - if waitResult <> WAIT_OBJECT_0 then - begin - // no com event triggered so either a timeout or internal error occurred - result := False; - Exit; - end; - - // com event was triggered. now check if the reponse was correctly received - if comEventInfo <> kResponse then - begin - result := False; - Exit; - end; - - // packet successfully transmitted and response packet received - result := True; -end; //*** end of SendPacket *** - - -//*************************************************************************************** -// NAME: Disconnect -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Disconnects the transport layer device. -// -//*************************************************************************************** -procedure TXcpTransport.Disconnect; -begin - canDriver.Disconnect; -end; //*** end of Disconnect *** - - -//*************************************************************************************** -// NAME: OnCanMessage -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Can message event handler -// -//*************************************************************************************** -procedure TXcpTransport.OnCanMessage( Sender: TObject; Direction: TDirection; Message: TCanMsg ); -var - cnt : integer; -begin - // the event we are interested in is the reception of the command response from - // slave. - if Direction = Rx then - begin - if Message.id = LongInt(PacketRxId) then - begin - // store response data - for cnt := 0 to Message.dlc-1 do - begin - packetData[cnt] := Message.data[cnt]; - end; - - // store response length - packetLen := Message.dlc; - - // set event flag - comEventInfo := kResponse; - - // trigger the event - SetEvent(comEvent); - end; - end; -end; //*** end of OnCanMessage *** - - -//*************************************************************************************** -// NAME: OnBusOff -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Bus off event handler -// -//*************************************************************************************** -procedure TXcpTransport.OnBusOff(Sender: TObject; time: LongInt); -begin - // set error event flag - comEventInfo := kError; - - // trigger the event - SetEvent(comEvent); -end; //*** end of OnBusOff *** - - -//*************************************************************************************** -// NAME: MsgWaitForSingleObject -// PRECONDITIONS: none -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Improved version of WaitForSingleObject. This version actually -// processes messages in the queue instead of blocking them. -// -//*************************************************************************************** -function TXcpTransport.MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; -var - dwEnd:DWord; -begin - // compute the time when the WaitForSingleObject is supposed to time out - dwEnd := GetTickCount + dwMilliseconds; - - repeat - // wait for an event to happen or a message to be in the queue - result := MsgWaitForMultipleObjects(1, hHandle, False, dwMilliseconds, QS_ALLINPUT); - - // a message was in the queue? - if result = WAIT_OBJECT_0 + 1 then - begin - // process these messages - Application.ProcessMessages; - - // check for timeout manually because if a message in the queue occurred, the - // MsgWaitForMultipleObjects will be called again and the timer will start from - // scratch. we need to make sure the correct timeout time is used. - dwMilliseconds := GetTickCount; - if dwMilliseconds < dwEnd then - begin - dwMilliseconds := dwEnd - dwMilliseconds; - end - else - begin - // timeout occured - result := WAIT_TIMEOUT; - Break; - end; - end - else - // the event occured? - begin - // we can stop - Break; - end; - until True = False; -end; //*** end of MsgWaitForSingleObject *** - - -end. -//******************************** end of XcpTransport.pas ****************************** - diff --git a/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.cfg b/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.cfg deleted file mode 100644 index d2841ff5..00000000 --- a/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.cfg +++ /dev/null @@ -1,35 +0,0 @@ --$A+ --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I+ --$J+ --$K- --$L+ --$M- --$N+ --$O+ --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E../../../../../ --LNc:\borland\delphi4\Lib diff --git a/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dof b/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dof deleted file mode 100644 index 564878ae..00000000 --- a/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dof +++ /dev/null @@ -1,87 +0,0 @@ -[Compiler] -A=1 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=1 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=../../../../../ -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40 -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1031 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[Excluded Packages] -$(DELPHI)\Lib\dclusr40.bpl=Borland User -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlOutputDirectorry] -Count=2 -Item0=../../../../../ -Item1=../../../../ diff --git a/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dpr b/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dpr deleted file mode 100644 index bbdc9133..00000000 --- a/Host/Source/MicroBoot/interfaces/can/vector/openblt_can_vector.dpr +++ /dev/null @@ -1,653 +0,0 @@ -library openblt_can_vector; -//*************************************************************************************** -// Project Name: MicroBoot Interface for Borland Delphi -// Description: XCP - CAN interface for MicroBoot supporting Vector CAN -// File Name: openblt_can_vector.dpr -// -//--------------------------------------------------------------------------------------- -// C O P Y R I G H T -//--------------------------------------------------------------------------------------- -// Copyright (c) 2011 by Feaser http://www.feaser.com All rights reserved -// -// This software has been carefully tested, but is not guaranteed for any particular -// purpose. The author does not offer any warranties and does not guarantee the accuracy, -// adequacy, or completeness of the software and is not responsible for any errors or -// omissions or the results obtained from use of the software. -// -//--------------------------------------------------------------------------------------- -// L I C E N S E -//--------------------------------------------------------------------------------------- -// This file is part of OpenBLT. OpenBLT is free software: you can redistribute it and/or -// modify it under the terms of the GNU General Public License as published by the Free -// Software Foundation, either version 3 of the License, or (at your option) any later -// version. -// -// OpenBLT is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; -// without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR -// PURPOSE. See the GNU General Public License for more details. -// -// You have received a copy of the GNU General Public License along with OpenBLT. It -// should be located in ".\Doc\license.html". If not, contact Feaser to obtain a copy. -// -//*************************************************************************************** - - -//*************************************************************************************** -// Includes -//*************************************************************************************** -uses - Windows, - Messages, - Graphics, - Controls, - Forms, - Dialogs, - SysUtils, - Classes, - Extctrls, - XcpProtection in '..\..\XcpProtection.pas', - SRecReader in '..\..\SRecReader.pas', - XcpDataFile in '..\..\XcpDataFile.pas', - XcpLoader in '..\..\XcpLoader.pas', - XcpTransport in 'XcpTransport.pas', - CANdrvD in 'CANdrvD.pas', - CANlibD in 'CANlibD.pas', - XcpSettings in 'XcpSettings.pas' {XcpSettingsForm}; - - -//*************************************************************************************** -// Global Constants -//*************************************************************************************** -const kMaxProgLen = 256; // maximum number of bytes to progam at one time - - -//*************************************************************************************** -// Type Definitions -//*************************************************************************************** -// DLL Interface Callbacks - modifications requires potential update of all interfaces! -type - TStartedEvent = procedure(length: Longword) of object; - TProgressEvent = procedure(progress: Longword) of object; - TDoneEvent = procedure of object; - TErrorEvent = procedure(error: ShortString) of object; - TLogEvent = procedure(info: ShortString) of object; - TInfoEvent = procedure(info: ShortString) of object; - -type - TEventHandlers = class // create a dummy class - procedure OnTimeout(Sender: TObject); - end; - -//*************************************************************************************** -// Global Variables -//*************************************************************************************** -var - //--- begin of don't change --- - AppOnStarted : TStartedEvent; - AppOnProgress : TProgressEvent; - AppOnDone : TDoneEvent; - AppOnError : TErrorEvent; - AppOnLog : TLogEvent; - AppOnInfo : TInfoEvent; - //--- end of don't change --- - timer : TTimer; - events : TEventHandlers; - loader : TXcpLoader; - datafile : TXcpDataFile; - progdata : array of Byte; - progfile : string; - stopRequest : boolean; - - -//*************************************************************************************** -// NAME: MbiCallbackOnStarted -// PARAMETER: length of the file that is being downloaded. -// RETURN VALUE: none -// DESCRIPTION: Wrapper function for safely calling an application callback -// -//*************************************************************************************** -procedure MbiCallbackOnStarted(length: Longword); -begin - if Assigned(AppOnStarted) then - begin - AppOnStarted(length); - end; -end; //** end of MbiCallbackOnStarted *** - - -//*************************************************************************************** -// NAME: MbiCallbackOnProgress -// PARAMETER: progress of the file download. -// RETURN VALUE: none -// DESCRIPTION: Wrapper function for safely calling an application callback -// -//*************************************************************************************** -procedure MbiCallbackOnProgress(progress: Longword); -begin - if Assigned(AppOnProgress) then - begin - AppOnProgress(progress); - end; -end; //** end of MbiCallbackOnProgress *** - - -//*************************************************************************************** -// NAME: MbiCallbackOnDone -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Wrapper function for safely calling an application callback -// -//*************************************************************************************** -procedure MbiCallbackOnDone; -begin - if Assigned(AppOnDone) then - begin - AppOnDone; - end; -end; //** end of MbiCallbackOnDone *** - - -//*************************************************************************************** -// NAME: MbiCallbackOnError -// PARAMETER: info about the error that occured. -// RETURN VALUE: none -// DESCRIPTION: Wrapper function for safely calling an application callback -// -//*************************************************************************************** -procedure MbiCallbackOnError(error: ShortString); -begin - if Assigned(AppOnError) then - begin - AppOnError(error); - end; -end; //** end of MbiCallbackOnError *** - - -//*************************************************************************************** -// NAME: MbiCallbackOnLog -// PARAMETER: info on the log event. -// RETURN VALUE: none -// DESCRIPTION: Wrapper function for safely calling an application callback -// -//*************************************************************************************** -procedure MbiCallbackOnLog(info: ShortString); -begin - if Assigned(AppOnLog) then - begin - AppOnLog(info); - end; -end; //** end of MbiCallbackOnLog *** - - -//*************************************************************************************** -// NAME: MbiCallbackOnInfo -// PARAMETER: details on the info event. -// RETURN VALUE: none -// DESCRIPTION: Wrapper function for safely calling an application callback -// -//*************************************************************************************** -procedure MbiCallbackOnInfo(info: ShortString); -begin - if Assigned(AppOnInfo) then - begin - AppOnInfo(info); - end; -end; //** end of MbiCallbackOnLog *** - - -//*************************************************************************************** -// NAME: LogData -// PARAMETER: pointer to byte array and the data length -// RETURN VALUE: none -// DESCRIPTION: Writes the program data formatted to the logfile -// -//*************************************************************************************** -procedure LogData(data : PByteArray; len : longword); stdcall; -var - currentWriteCnt : byte; - cnt : byte; - logStr : string; - bufferOffset : longword; -begin - bufferOffset := 0; - - while len > 0 do - begin - // set the current write length optimized to log 32 bytes per line - currentWriteCnt := len mod 32; - if currentWriteCnt = 0 then currentWriteCnt := 32; - logStr := ''; - - // prepare the line to add to the log - for cnt := 0 to currentWriteCnt-1 do - begin - logStr := logStr + Format('%2.2x ', [data[bufferOffset+cnt]]); - end; - - // update the log - MbiCallbackOnLog(logStr); - - // update loop variables - len := len - currentWriteCnt; - bufferOffset := bufferOffset + currentWriteCnt; - end; -end; //*** end of LogData *** - - -//*************************************************************************************** -// NAME: OnTimeout -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Timer event handler. A timer is used in this example to simulate the -// progress of a file download. It also demonstrates how to use the -// application callbacks to keep the application informed. -// -//*************************************************************************************** -procedure TEventHandlers.OnTimeout(Sender: TObject); -var - errorInfo : string; - progress : longword; - regionCnt : longword; - currentWriteCnt : word; - sessionStartResult : byte; - bufferOffset : longword; - addr : longword; - len : longword; - dataSizeKB : real; -begin - timer.Enabled := False; - - // connect the transport layer - MbiCallbackOnInfo('Connecting to the CAN interface.'); - MbiCallbackOnLog('Connecting to the CAN interface. t='+TimeToStr(Time)); - Application.ProcessMessages; - if not loader.Connect then - begin - // update the user info - MbiCallbackOnError('Could not connect to CAN interface. Check your configuration.'); - MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+TimeToStr(Time)); - Exit; - end; - - //---------------- start the programming session -------------------------------------- - MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time)); - - // try initial connect via XCP. if the user program is able to reactivate the bootloader - // it will do so now - sessionStartResult := loader.StartProgrammingSession; - if sessionStartResult = kProgSessionUnlockError then - begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); - MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); - loader.Disconnect; - Exit; - end; - // try initial connect via XCP - if sessionStartResult <> kProgSessionStarted then - begin - // update the user info - MbiCallbackOnInfo('Could not connect. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+TimeToStr(Time)); - Application.ProcessMessages; - // possible that the bootloader is being activated, which means that the target's - // CAN controller is being reinitialized. We should not send any data on the CAN - // network for this to finish. 200ms should do it. not that the backdoor entry time - // should be at least 2.5x this. - Sleep(200); - // continuously try to connect via XCP true the backdoor - sessionStartResult := kProgSessionGenericError; - while sessionStartResult <> kProgSessionStarted do - begin - sessionStartResult := loader.StartProgrammingSession; - Application.ProcessMessages; - Sleep(5); - // if the is in reset of otherwise does not have the CAN controller synchronized to - // the CAN bus, we will be generating error frames, possibly leading to a bus off. - // check for this - if loader.IsComError then - begin - // bus off state, so try to recover. - MbiCallbackOnLog('Communication error detected. Trying automatic recovery. t='+TimeToStr(Time)); - loader.Disconnect; - if not loader.Connect then - begin - MbiCallbackOnLog('Could not connect to CAN interface. Check your configuration and try again. t='+TimeToStr(Time)); - MbiCallbackOnError('Could not connect to CAN interface. Check your configuration.'); - Exit; - end; - Sleep(200); - end; - // don't retry if the error was caused by not being able to unprotect the programming resource - if sessionStartResult = kProgSessionUnlockError then - begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); - MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); - Exit; - end; - - // check if the user cancelled - if stopRequest then - begin - MbiCallbackOnError('Programming session cancelled by user.'); - Exit; - end; - end; - end; - - // still here so programming session was started - MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time)); - - // create the datafile object - datafile := TXcpDataFile.Create(progfile); - - // compute the size in kbytes - dataSizeKB := datafile.GetDataCnt / 1024; - - // Call application callback when we start the actual download - MbiCallbackOnStarted(datafile.GetDataCnt); - - // Init progress to 0 progress - progress := 0; - MbiCallbackOnProgress(progress); - - //---------------- next clear the memory regions -------------------------------------- - // update the user info - MbiCallbackOnInfo('Erasing memory...'); - - for regionCnt := 0 to datafile.GetRegionCnt-1 do - begin - // obtain the region info - datafile.GetRegionInfo(regionCnt, addr, len); - - // erase the memory - MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time)); - if not loader.ClearMemory(addr, len) then - begin - loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not clear memory ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not clear memory ('+errorInfo+').'); - datafile.Free; - Exit; - end; - MbiCallbackOnLog('Memory cleared. t='+TimeToStr(Time)); - end; - - //---------------- next program the memory regions ------------------------------------ - for regionCnt := 0 to datafile.GetRegionCnt-1 do - begin - // update the user info - MbiCallbackOnInfo('Reading file...'); - - // obtain the region info - datafile.GetRegionInfo(regionCnt, addr, len); - // dynamically allocated buffer memory - SetLength(progdata, len); - // obtain the regiond data - datafile.GetRegionData(regionCnt, progdata); - - bufferOffset := 0; - while len > 0 do - begin - // set the current write length taking into account kMaxProgLen - currentWriteCnt := len mod kMaxProgLen; - if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen; - - // program the data - MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time)); - LogData(@progdata[bufferOffset], currentWriteCnt); - - if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then - begin - loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not program data ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not program data ('+errorInfo+').'); - datafile.Free; - Exit; - end; - MbiCallbackOnLog('Data Programmed. t='+TimeToStr(Time)); - - // update progress - progress := progress + currentWriteCnt; - MbiCallbackOnProgress(progress); - - // update loop variables - len := len - currentWriteCnt; - addr := addr + currentWriteCnt; - bufferOffset := bufferOffset + currentWriteCnt; - - // update the user info - MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])); - - end; - end; - - //---------------- stop the programming session --------------------------------------- - MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time)); - if not loader.StopProgrammingSession then - begin - loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not stop the programming session ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not stop the programming session ('+errorInfo+').'); - datafile.Free; - Exit; - end; - MbiCallbackOnLog('Programming session stopped. t='+TimeToStr(Time)); - - // all done so set progress to 100% and finish up - progress := datafile.GetDataCnt; - datafile.Free; - MbiCallbackOnProgress(progress); - MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time)); - MbiCallbackOnDone; - -end; //*** end of OnTimeout *** - - -//*************************************************************************************** -// NAME: MbiInit -// PARAMETER: callback function pointers -// RETURN VALUE: none -// DESCRIPTION: Called by the application to initialize the interface library. -// -//*************************************************************************************** -procedure MbiInit(cbStarted: TStartedEvent; cbProgress: TProgressEvent; - cbDone: TDoneEvent; cbError: TErrorEvent; cbLog: TLogEvent; - cbInfo: TInfoEvent); stdcall; -begin - //--- begin of don't change --- - AppOnStarted := cbStarted; - AppOnProgress := cbProgress; - AppOnDone := cbDone; - AppOnLog := cbLog; - AppOnInfo := cbInfo; - AppOnError := cbError; - //--- end of don't change --- - - // create xcp loader object - loader := TXcpLoader.Create; - - // update to the latest configuration - loader.Configure(ExtractFilePath(ParamStr(0))+'openblt_can_vector.ini'); - - // create and init a timer - events := TEventHandlers.Create; - timer := TTimer.Create(nil); - timer.Enabled := False; - timer.Interval := 100; - timer.OnTimer := events.OnTimeout; -end; //*** end of MbiInit *** - - -//*************************************************************************************** -// NAME: MbiStart -// PARAMETER: filename of the file that is to be downloaded. -// RETURN VALUE: none -// DESCRIPTION: Called by the application to request the interface library to download -// the file that is passed as a parameter. -// -//*************************************************************************************** -procedure MbiStart(fileName: ShortString); stdcall; -begin - // update the user info - MbiCallbackOnInfo(''); - - // start the log - MbiCallbackOnLog('--- Downloading "'+fileName+'" ---'); - - // reset stop request - stopRequest := false; - - // start the startup timer which gives microBoot a chance to paint itself - timer.Enabled := True; - - // store the program's filename - progfile := fileName; -end; //*** end of MbiStart *** - - -//*************************************************************************************** -// NAME: MbiStop -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Called by the application to request the interface library to stop -// a download that could be in progress. -// -//*************************************************************************************** -procedure MbiStop; stdcall; -begin - // set stop request - stopRequest := true; - - // disconnect the transport layer - MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time)); - loader.Disconnect; -end; //*** end of MbiStop *** - - -//*************************************************************************************** -// NAME: MbiDeInit -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Called by the application to uninitialize the interface library. -// -//*************************************************************************************** -procedure MbiDeInit; stdcall; -begin - // release xcp loader object - loader.Free; - - // release the timer and events object - timer.Free; - events.Free; - - //--- begin of don't change --- - AppOnStarted := nil; - AppOnProgress := nil; - AppOnDone := nil; - AppOnLog := nil; - AppOnInfo := nil; - AppOnError := nil; - //--- end of don't change --- -end; //*** end of MbiDeInit *** - - -//*************************************************************************************** -// NAME: MbiName -// PARAMETER: none -// RETURN VALUE: name of the interface library -// DESCRIPTION: Called by the application to obtain the name of the interface library. -// -//*************************************************************************************** -function MbiName : ShortString; stdcall; -begin - Result := 'OpenBLT CAN Vector'; -end; //*** end of MbiName *** - - -//*************************************************************************************** -// NAME: MbiDescription -// PARAMETER: none -// RETURN VALUE: description of the interface library -// DESCRIPTION: Called by the application to obtain the description of the interface -// library. -// -//*************************************************************************************** -function MbiDescription : ShortString; stdcall; -begin - Result := 'OpenBLT using Vector CAN Interface'; -end; //*** end of MbiDescription *** - - -//*************************************************************************************** -// NAME: MbiVersion -// PARAMETER: none -// RETURN VALUE: version number -// DESCRIPTION: Called by the application to obtain the version number of the -// interface library. -// -//*************************************************************************************** -function MbiVersion : Longword; stdcall; -begin - Result := 10000; // v1.00.00 -end; //*** end of MbiVersion *** - - -//*************************************************************************************** -// NAME: MbiVInterface -// PARAMETER: none -// RETURN VALUE: version number of the supported interface -// DESCRIPTION: Called by the application to obtain the version number of the -// Mbi interface uBootInterface.pas (not the interface library). This can -// be used by the application for backward compatibility. -// -//*************************************************************************************** -function MbiVInterface : Longword; stdcall; -begin - Result := 10001; // v1.00.01 -end; //*** end of MbiVInterface *** - - -//*************************************************************************************** -// NAME: MbiConfigure -// PARAMETER: none -// RETURN VALUE: none -// DESCRIPTION: Called by the application to enable the user to configure the inter- -// face library through the application. -// -//*************************************************************************************** -procedure MbiConfigure; stdcall; -var - settings : TXcpSettings; -begin - // create xcp settings object - settings := TXcpSettings.Create(ExtractFilePath(ParamStr(0))+'openblt_can_vector.ini'); - - // display the modal configuration dialog - settings.Configure; - - // release the xcp settings object - settings.Free; - - // update to the latest configuration - loader.Configure(ExtractFilePath(ParamStr(0))+'openblt_can_vector.ini'); -end; //*** end of MbiConfigure *** - - -//*************************************************************************************** -// External Declarations -//*************************************************************************************** -exports - //--- begin of don't change --- - MbiInit index 1, - MbiStart index 2, - MbiStop index 3, - MbiDeInit index 4, - MbiName index 5, - MbiDescription index 6, - MbiVersion index 7, - MbiConfigure index 8, - MbiVInterface index 9; - //--- end of don't change --- - -end. -//********************************** end of openblt_can_vector.dpr ********************** diff --git a/Host/Source/MicroBoot/interfaces/net/WSockets.pas b/Host/Source/MicroBoot/interfaces/net/WSockets.pas index db7c5c76..e81d36d9 100644 --- a/Host/Source/MicroBoot/interfaces/net/WSockets.pas +++ b/Host/Source/MicroBoot/interfaces/net/WSockets.pas @@ -425,8 +425,8 @@ begin with WSAData do begin FVersion:= Concat(IntToStr(Hi(wVersion)),'.',(IntToStr(Lo(wVersion)))); - FDescription:= StrPas(szDescription); - FSystemStatus:= StrPas(szSystemStatus); + FDescription:= String(szDescription); + FSystemStatus:= String(szSystemStatus); FMaxSockets:= iMaxSockets; FMaxUDPSize:= iMaxUDPDg; end; @@ -462,16 +462,16 @@ begin Exit; end; - ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name); + ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name); if ServEnt = nil then SockAddrIn.sin_port:= htons(StrToInt(Port)) else SockAddrIn.sin_port:= ServEnt^.s_port; - SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(Host)); - if SockAddrIn.sin_addr.s_addr = INADDR_NONE then + SockAddrIn.sin_addr.s_addr:= inet_addr(PAnsiChar(AnsiString(Host))); + if SockAddrIn.sin_addr.s_addr = Integer(INADDR_NONE) then begin - HostEnt:= gethostbyname(PChar(Host)); + HostEnt:= gethostbyname(PAnsiChar(AnsiString(Host))); if HostEnt = nil then begin SocketError(WSAGetLastError); @@ -495,7 +495,7 @@ begin if ProtoEnt = nil then Exit; - ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name); + ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name); if ServEnt = nil then SockAddrIn.sin_port:= htons(StrToInt(Port)) else @@ -518,13 +518,13 @@ begin if ProtoEnt = nil then Exit; - ServEnt:= getservbyname(PChar(Port), ProtoEnt^.p_name); + ServEnt:= getservbyname(PAnsiChar(AnsiString(Port)), ProtoEnt^.p_name); if ServEnt = nil then SockAddrIn.sin_port:= htons(StrToInt(Port)) else SockAddrIn.sin_port:= ServEnt^.s_port; - SockAddrIn.sin_addr.s_addr:= INADDR_BROADCAST; + SockAddrIn.sin_addr.s_addr:= Integer(INADDR_BROADCAST); Result:= true; end; @@ -534,12 +534,12 @@ var begin HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); if HostEnt <> nil then - Result:= HostEnt.h_name; + Result:= String(AnsiString(HostEnt.h_name)); end; function TCustomWSocket.SockAddrInToAddress(SockAddrIn: TSockAddrIn): string; begin - Result:= inet_ntoa(SockAddrIn.sin_addr); + Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr))); end; function TCustomWSocket.SockAddrInToPort(SockAddrIn: TSockAddrIn): string; @@ -560,7 +560,7 @@ begin begin HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); if HostEnt <> nil then - Result:= HostEnt.h_name; + Result:= String(AnsiString(HostEnt.h_name)); end; end; end; @@ -574,7 +574,7 @@ begin begin Len:= SizeOf(SockAddrIn); if getsockname(Socket, SockAddrIn, Len) <> SOCKET_ERROR then - Result:= inet_ntoa(SockAddrIn.sin_addr); + Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr))); end; end; @@ -604,7 +604,7 @@ begin begin HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET); if HostEnt <> nil then - Result:= HostEnt.h_name; + Result:= String(AnsiString(HostEnt.h_name)); end; end; end; @@ -618,7 +618,7 @@ begin begin Len:= SizeOf(SockAddrIn); if getpeername(Socket, SockAddrIn, Len) <> SOCKET_ERROR then - Result:= inet_ntoa(SockAddrIn.sin_addr); + Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr))); end; end; @@ -881,7 +881,7 @@ function TCustomWSocket.GetLocalHostAddress: string; var SockAddrIn: TSockAddrIn; HostEnt: PHostEnt; - szHostName: array[0..128] of char; + szHostName: array[0..128] of ansichar; begin if gethostname(szHostName, 128) = 0 then begin @@ -891,7 +891,7 @@ begin else begin SockAddrIn.sin_addr.S_addr:= longint(plongint(HostEnt^.h_addr_list^)^); - Result:= inet_ntoa(SockAddrIn.sin_addr); + Result:= String(AnsiString(inet_ntoa(SockAddrIn.sin_addr))); end; end else @@ -900,10 +900,10 @@ end; function TCustomWSocket.GetLocalHostName: string; var - szHostName: array[0..128] of char; + szHostName: array[0..128] of ansichar; begin if gethostname(szHostName, 128) = 0 then - Result:= szHostName + Result:= String(AnsiString(szHostName)) else SocketError(WSAGetLastError); end; @@ -1019,7 +1019,7 @@ begin end; SockOpt:= true; {Enable OOB Data inline} - if setsockopt(FLocalSocket, SOL_SOCKET, SO_OOBINLINE, PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then + if setsockopt(FLocalSocket, SOL_SOCKET, SO_OOBINLINE, PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then begin SocketError(WSAGetLastError); closesocket(FLocalSocket); @@ -1136,7 +1136,7 @@ begin end; SockOpt:= true; {Enable OOB Data inline} - if setsockopt(NewSocket, SOL_SOCKET, SO_OOBINLINE , PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then + if setsockopt(NewSocket, SOL_SOCKET, SO_OOBINLINE , PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then begin SocketError(WSAGetLastError); closesocket(NewSocket); @@ -1495,7 +1495,7 @@ begin end; SockOpt:= true; {Enable Broadcasting on this Socket} - if setsockopt(FLocalSocket, SOL_SOCKET, SO_BROADCAST, PChar(@SockOpt), SizeOf(SockOpt)) <> 0 then + if setsockopt(FLocalSocket, SOL_SOCKET, SO_BROADCAST, PAnsiChar(@SockOpt), SizeOf(SockOpt)) <> 0 then begin SocketError(WSAGetLastError); closesocket(FLocalSocket); diff --git a/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm index 47615e4b..b35a68d2 100644 Binary files a/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm and b/Host/Source/MicroBoot/interfaces/net/XcpSettings.dfm differ diff --git a/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas index 98a0339a..ea11d0a0 100644 --- a/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas +++ b/Host/Source/MicroBoot/interfaces/net/XcpSettings.pas @@ -36,7 +36,7 @@ interface //*************************************************************************************** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ComCtrls, ExtCtrls, IniFiles; + StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage; //*************************************************************************************** @@ -76,7 +76,6 @@ type edtPort: TEdit; edtTconnect: TEdit; lblTconnect: TLabel; - chbSocketRetry: TCheckBox; procedure btnOKClick(Sender: TObject); procedure btnCancelClick(Sender: TObject); procedure btnBrowseClick(Sender: TObject); @@ -203,7 +202,6 @@ begin // NET related elements FSettingsForm.edtHostname.Text := settingsIni.ReadString('net', 'hostname', '169.254.19.63'); FSettingsForm.edtPort.Text := settingsIni.ReadString('net', 'port', '1000'); - FSettingsForm.chbSocketRetry.Checked := settingsIni.ReadBool('net', 'retry', false); // XCP related elements FSettingsForm.edtSeedKey.Text := settingsIni.ReadString('xcp', 'seedkey', ExtractFilePath(ParamStr(0))+''); @@ -223,7 +221,6 @@ begin // NET related elements FSettingsForm.edtHostname.Text := '169.254.19.63'; FSettingsForm.edtPort.Text := '1000'; - FSettingsForm.chbSocketRetry.Checked := false; // XCP related elements FSettingsForm.edtSeedKey.Text := ExtractFilePath(ParamStr(0))+''; @@ -246,7 +243,6 @@ begin // NET related elements settingsIni.WriteString('net', 'hostname', FSettingsForm.edtHostname.Text); settingsIni.WriteString('net', 'port', FSettingsForm.edtPort.Text); - settingsIni.WriteBool('net', 'retry', FSettingsForm.chbSocketRetry.Checked); // XCP related elements settingsIni.WriteString('xcp', 'seedkey', FSettingsForm.edtSeedKey.Text); diff --git a/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas index df1bdd7d..79bd37cc 100644 --- a/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas +++ b/Host/Source/MicroBoot/interfaces/net/XcpTransport.pas @@ -61,7 +61,6 @@ type socket : TTCPClient; hostname : string; port : string; - connectRetry : Boolean; croCounter : LongWord; procedure OnSocketDataAvailable(Sender: TObject; WinSocket: TSocket); function MsgWaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; @@ -156,9 +155,6 @@ begin // configure port port := settingsIni.ReadString('net', 'port', '1000'); - // configure the connection retry feature - connectRetry := settingsIni.ReadBool('net', 'retry', false); - // release ini file object settingsIni.Free; end @@ -169,9 +165,6 @@ begin // configure default port port := '1000'; - - // configure default connection retry feature setting - connectRetry := false; end; end; //*** end of Configure *** @@ -208,15 +201,11 @@ begin // wait for the connection to be established while socket.SocketState <> ssConnected do begin - // check timeout if connection retry feature is enabled - if connectRetry then + // check for timeout + if GetTickCount > connectTimeout then begin - // check for timeout - if GetTickCount > connectTimeout then - begin - result := false; - Exit; - end; + result := false; + Exit; end; Application.ProcessMessages; diff --git a/Host/Source/MicroBoot/interfaces/net/openblt_net.cfg b/Host/Source/MicroBoot/interfaces/net/openblt_net.cfg deleted file mode 100644 index 7e67a882..00000000 --- a/Host/Source/MicroBoot/interfaces/net/openblt_net.cfg +++ /dev/null @@ -1,35 +0,0 @@ --$A+ --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I+ --$J+ --$K- --$L+ --$M- --$N+ --$O+ --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E../../../../ --LNc:\borland\delphi4\Lib diff --git a/Host/Source/MicroBoot/interfaces/net/openblt_net.dof b/Host/Source/MicroBoot/interfaces/net/openblt_net.dof deleted file mode 100644 index 5d0ef50e..00000000 --- a/Host/Source/MicroBoot/interfaces/net/openblt_net.dof +++ /dev/null @@ -1,85 +0,0 @@ -[Compiler] -A=1 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=1 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=../../../../ -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;IcsDel40 -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1043 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlOutputDirectorry] -Count=2 -Item0=../../../../ -Item1=../../../ diff --git a/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr b/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr index 6471202c..13f96c10 100644 --- a/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr +++ b/Host/Source/MicroBoot/interfaces/net/openblt_net.dpr @@ -224,7 +224,7 @@ begin end; // update the log - MbiCallbackOnLog(logStr); + MbiCallbackOnLog(ShortString(logStr)); // update loop variables len := len - currentWriteCnt; @@ -258,14 +258,14 @@ begin // connect the transport layer MbiCallbackOnInfo('Connecting to target via TCP/IP. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Connecting to target via TCP/IP. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connecting to target via TCP/IP. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; if not loader.Connect then begin // update the user info MbiCallbackOnInfo('Could not connect via TCP/IP. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Transport layer connection failed. Check the configured IP address and port. t='+TimeToStr(Time)); - MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+TimeToStr(Time)); + MbiCallbackOnLog('Transport layer connection failed. Check the configured IP address and port. t='+ShortString(TimeToStr(Time))); + MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // continuously try to connect the transport layer while not loader.Connect do @@ -282,11 +282,11 @@ begin // we now have a socket connected to the target. next attempt to connect to the target // via XCP. - MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time))); sessionStartResult := loader.StartProgrammingSession; if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); loader.Disconnect; Exit; @@ -299,18 +299,18 @@ begin // ration of the ethernet controller so we need to disconnect the socket here and // wait for it to reconnect. MbiCallbackOnInfo('No response from target. Disconnecting TCP/IP socket.'); - MbiCallbackOnLog('No response from target. Disconnecting TCP/IP socket. t='+TimeToStr(Time)); + MbiCallbackOnLog('No response from target. Disconnecting TCP/IP socket. t='+ShortString(TimeToStr(Time))); loader.Disconnect; // connect the transport layer MbiCallbackOnInfo('Connecting to target via TCP/IP. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Connecting to target via TCP/IP. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connecting to target via TCP/IP. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; if not loader.Connect then begin // update the user info MbiCallbackOnInfo('Could not connect via TCP/IP. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Transport layer connection failed. Check the configured IP address and port. t='+TimeToStr(Time)); - MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+TimeToStr(Time)); + MbiCallbackOnLog('Transport layer connection failed. Check the configured IP address and port. t='+ShortString(TimeToStr(Time))); + MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // continuously try to connect the transport layer while not loader.Connect do @@ -325,12 +325,12 @@ begin end; end; //---------------- start the programming session -------------------------------------- - MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time))); // try initial connect via XCP sessionStartResult := loader.StartProgrammingSession; if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); loader.Disconnect; Exit; @@ -341,7 +341,7 @@ begin begin // update the user info MbiCallbackOnInfo('Could not connect. Please reset your target...'); - MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // continuously try to connect via XCP true the backdoor sessionStartResult := kProgSessionGenericError; @@ -353,7 +353,7 @@ begin // don't retry if the error was caused by not being able to unprotect the programming resource if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); Exit; end; @@ -369,7 +369,7 @@ begin end; // still here so programming session was started - MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time))); // create the datafile object datafile := TXcpDataFile.Create(progfile); @@ -394,16 +394,16 @@ begin datafile.GetRegionInfo(regionCnt, addr, len); // erase the memory - MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Clearing Memory '+ShortString(Format('addr:0x%x,len:0x%x',[addr,len]))+'. t='+ShortString(TimeToStr(Time))); if not loader.ClearMemory(addr, len) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not clear memory ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not clear memory ('+errorInfo+').'); + MbiCallbackOnLog('Could not clear memory ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not clear memory ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Memory cleared. t='+TimeToStr(Time)); + MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time))); end; //---------------- next program the memory regions ------------------------------------ @@ -427,18 +427,18 @@ begin if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen; // program the data - MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming Data '+ShortString(Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt]))+'. t='+ShortString(TimeToStr(Time))); LogData(@progdata[bufferOffset], currentWriteCnt); if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not program data ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not program data ('+errorInfo+').'); + MbiCallbackOnLog('Could not program data ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not program data ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Data Programmed. t='+TimeToStr(Time)); + MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time))); // update progress progress := progress + currentWriteCnt; @@ -450,28 +450,28 @@ begin bufferOffset := bufferOffset + currentWriteCnt; // update the user info - MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])); + MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]))); end; end; //---------------- stop the programming session --------------------------------------- - MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Stopping the programming session. t='+ShortString(TimeToStr(Time))); if not loader.StopProgrammingSession then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not stop the programming session ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not stop the programming session ('+errorInfo+').'); + MbiCallbackOnLog('Could not stop the programming session ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not stop the programming session ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Programming session stopped. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time))); // all done so set progress to 100% and finish up progress := datafile.GetDataCnt; datafile.Free; MbiCallbackOnProgress(progress); - MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time)); + MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time))); MbiCallbackOnDone; end; //*** end of OnTimeout *** @@ -535,7 +535,7 @@ begin timer.Enabled := True; // store the program's filename - progfile := fileName; + progfile := String(fileName); end; //*** end of MbiStart *** @@ -553,7 +553,7 @@ begin stopRequest := true; // disconnect the transport layer - MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time)); + MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time))); loader.Disconnect; end; //*** end of MbiStop *** @@ -672,15 +672,15 @@ end; //*** end of MbiConfigure *** //*************************************************************************************** exports //--- begin of don't change --- - MbiInit index 1, - MbiStart index 2, - MbiStop index 3, - MbiDeInit index 4, - MbiName index 5, - MbiDescription index 6, - MbiVersion index 7, - MbiConfigure index 8, - MbiVInterface index 9; + MbiInit, + MbiStart, + MbiStop, + MbiDeInit, + MbiName, + MbiDescription, + MbiVersion, + MbiConfigure, + MbiVInterface; //--- end of don't change --- end. diff --git a/Host/Source/MicroBoot/interfaces/net/openblt_net.dproj b/Host/Source/MicroBoot/interfaces/net/openblt_net.dproj new file mode 100644 index 00000000..4116efa5 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/net/openblt_net.dproj @@ -0,0 +1,120 @@ + + + {B16E2683-DC28-4FA8-9418-7F3350903FA7} + openblt_net.dpr + True + Debug + 1 + Library + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + true + true + Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;IcsDel40;$(DCC_UsePackage) + false + false + 1 + 1 + false + openblt_net + 1 + false + true + ../../../../ + 00400000 + 1043 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + + + 1033 + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + + + 0 + 0 + false + RELEASE;$(DCC_Define) + + + true + DEBUG;$(DCC_Define) + false + + + (None) + 1033 + C:\Work\software\OpenBLT\Host\MicroBoot.exe + true + + + + MainSource + + + + + + + +
XcpSettingsForm
+ + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + openblt_net.dpr + + + + True + + + 12 + + + + diff --git a/Host/Source/MicroBoot/interfaces/uart/CPDrv.pas b/Host/Source/MicroBoot/interfaces/uart/CPDrv.pas deleted file mode 100644 index c3d08f2d..00000000 --- a/Host/Source/MicroBoot/interfaces/uart/CPDrv.pas +++ /dev/null @@ -1,1158 +0,0 @@ -//*************************************************************************************** -// 20060225: Updated by Frank Voorburg - Feaser -// -// - When using ReadXxx the windows messages are now being processed -// - When using ReadXxx the loop will stop (FCancel) upon disconnect -//*************************************************************************************** - -//------------------------------------------------------------------------ -// UNIT : CPDrv.pas -// CONTENTS : TCommPortDriver component -// VERSION : 2.1 -// TARGET : (Inprise's) Borland Delphi 4.0 -// AUTHOR : Marco Cocco -// STATUS : Freeware -// INFOS : Implementation of TCommPortDriver component: -// - non multithreaded serial I/O -// KNOWN BUGS : none -// COMPATIBILITY : Windows 95/98/NT/2000 -// REPLACES : TCommPortDriver v2.00 (Delphi 4.0) -// TCommPortDriver v1.08/16 (Delphi 1.0) -// TCommPortDriver v1.08/32 (Delphi 2.0/3.0) -// BACK/COMPAT. : partial - a lot of properties have been renamed -// RELEASE DATE : 06/06/2000 -// (Replaces v2.0 released on 30/NOV/1998) -//------------------------------------------------------------------------ -// FOR UPDATES : - sorry, no home page - -// BUGS REPORT : mail to : mcocco@libero.it -// or: ditrek@tiscalinet.it -//------------------------------------------------------------------------ -// -// Copyright (c) 1996-2000 by Marco Cocco. All rights reseved. -// Copyright (c) 1996-2000 by d3k Software Company. All rights reserved. -// -//****************************************************************************** -//* Permission to use, copy, modify, and distribute this software and its * -//* documentation without fee for any purpose is hereby granted, * -//* provided that the above copyright notice appears on all copies and that * -//* both that copyright notice and this permission notice appear in all * -//* supporting documentation. * -//* * -//* NO REPRESENTATIONS ARE MADE ABOUT THE SUITABILITY OF THIS SOFTWARE FOR ANY * -//* PURPOSE. IT IS PROVIDED "AS IS" WITHOUT EXPRESS OR IMPLIED WARRANTY. * -//* NEITHER MARCO COCCO OR D3K SHALL BE LIABLE FOR ANY DAMAGES SUFFERED BY * -//* THE USE OF THIS SOFTWARE. * -//****************************************************************************** - -unit CPDrv; - -interface - -uses - // Delphi units - Windows, Messages, SysUtils, Forms, Classes - // ComDrv32 units - ; - -//------------------------------------------------------------------------ -// Property types -//------------------------------------------------------------------------ - -type - // Baud Rates (custom or 110...256k bauds) - TBaudRate = ( brCustom, - br110, br300, br600, br1200, br2400, br4800, - br9600, br14400, br19200, br38400, br56000, - br57600, br115200, br128000, br256000 ); - // Port Numbers ( custom or COM1..COM16 ) - TPortNumber = ( pnCustom, - pnCOM1, pnCOM2, pnCOM3, pnCOM4, pnCOM5, pnCOM6, pnCOM7, - pnCOM8, pnCOM9, pnCOM10, pnCOM11, pnCOM12, pnCOM13, - pnCOM14, pnCOM15, pnCOM16 ); - // Data bits ( 5, 6, 7, 8 ) - TDataBits = ( db5BITS, db6BITS, db7BITS, db8BITS ); - // Stop bits ( 1, 1.5, 2 ) - TStopBits = ( sb1BITS, sb1HALFBITS, sb2BITS ); - // Parity ( None, odd, even, mark, space ) - TParity = ( ptNONE, ptODD, ptEVEN, ptMARK, ptSPACE ); - // Hardware Flow Control ( None, None + RTS always on, RTS/CTS ) - THwFlowControl = ( hfNONE, hfNONERTSON, hfRTSCTS ); - // Software Flow Control ( None, XON/XOFF ) - TSwFlowControl = ( sfNONE, sfXONXOFF ); - // What to do with incomplete (incoming) packets ( Discard, Pass ) - TPacketMode = ( pmDiscard, pmPass ); - -//------------------------------------------------------------------------ -// Event types -//------------------------------------------------------------------------ - -type - // RX event ( packet mode disabled ) - TReceiveDataEvent = procedure( Sender: TObject; DataPtr: pointer; DataSize: DWORD ) of object; - // RX event ( packed mode enabled ) - TReceivePacketEvent = procedure( Sender: TObject; Packet: pointer; DataSize: DWORD ) of object; - -//------------------------------------------------------------------------ -// Other types -//------------------------------------------------------------------------ - -type - // Line status ( Clear To Send, Data Set Ready, Ring, Carrier Detect ) - TLineStatus = ( lsCTS, lsDSR, lsRING, lsCD ); - // Set of line status - TLineStatusSet = set of TLineStatus; - -//------------------------------------------------------------------------ -// Constants -//------------------------------------------------------------------------ - -const - RELEASE_NOCLOSE_PORT = HFILE(INVALID_HANDLE_VALUE-1); - -//------------------------------------------------------------------------ -// TCommPortDriver component -//------------------------------------------------------------------------ - -type - TCommPortDriver = class( TComponent ) - protected - // Device Handle ( File Handle ) - FHandle : HFILE; - // # of the COM port to use, or pnCustom to use custom port name - FPort : TPortNumber; - // Custom port name ( usually '\\.\COMn', with n = 1..x ) - FPortName : string; - // COM Port speed (brXXX) - FBaudRate : TBaudRate; - // Baud rate ( actual numeric value ) - FBaudRateValue : DWORD; - // Data bits size (dbXXX) - FDataBits : TDataBits; - // How many stop bits to use (sbXXX) - FStopBits : TStopBits; - // Type of parity to use (ptXXX) - FParity : TParity; - // Type of hw handshaking (hw flow control) to use (hfXXX) - FHwFlow : THwFlowControl; - // Type of sw handshaking (sw flow control) to use (sFXXX) - FSwFlow : TSwFlowControl; - // Size of the input buffer - FInBufSize : DWORD; - // Size of the output buffer - FOutBufSize : DWORD; - // Size of a data packet - FPacketSize : smallint; - // ms to wait for a complete packet (<=0 = disabled) - FPacketTimeout : integer; - // What to do with incomplete packets (pmXXX) - FPacketMode : TPacketMode; - // Event to raise on data reception (asynchronous) - FOnReceiveData : TReceiveDataEvent; - // Event to raise on packet reception (asynchronous) - FOnReceivePacket : TReceivePacketEvent; - // ms of delay between COM port pollings - FPollingDelay : word; - // Specifies if the DTR line must be enabled/disabled on connect - FEnableDTROnOpen : boolean; - // Output timeout - milliseconds - FOutputTimeout : word; - // Timeout for ReadData - FInputTimeout : DWORD; - // Set to TRUE to prevent hangs when no device connected or - // device is OFF - FCkLineStatus : boolean; - // This is used for the timer - FNotifyWnd : HWND; - // Temporary buffer (RX) - used internally - FTempInBuffer : pointer; - // Time of the first byte of current RX packet - FFirstByteOfPacketTime : DWORD; - // Number of RX polling timer pauses - FRXPollingPauses : integer; - - FCancel : Boolean; - - // Sets the COM port handle - procedure SetHandle( Value: HFILE ); - // Selects the COM port to use - procedure SetPort( Value: TPortNumber ); - // Sets the port name - procedure SetPortName( Value: string ); - // Selects the baud rate - procedure SetBaudRate( Value: TBaudRate ); - // Selects the baud rate ( actual baud rate value ) - procedure SetBaudRateValue( Value: DWORD ); - // Selects the number of data bits - procedure SetDataBits( Value: TDataBits ); - // Selects the number of stop bits - procedure SetStopBits( Value: TStopBits ); - // Selects the kind of parity - procedure SetParity( Value: TParity ); - // Selects the kind of hardware flow control - procedure SetHwFlowControl( Value: THwFlowControl ); - // Selects the kind of software flow control - procedure SetSwFlowControl( Value: TSwFlowControl ); - // Sets the RX buffer size - procedure SetInBufSize( Value: DWORD ); - // Sets the TX buffer size - procedure SetOutBufSize( Value: DWORD ); - // Sets the size of incoming packets - procedure SetPacketSize( Value: smallint ); - // Sets the timeout for incoming packets - procedure SetPacketTimeout( Value: integer ); - // Sets the delay between polling checks - procedure SetPollingDelay( Value: word ); - // Applies current settings to open COM port - function ApplyCOMSettings: boolean; - // Polling proc - procedure TimerWndProc( var msg: TMessage ); - public - // Constructor - constructor Create( AOwner: TComponent ); override; - // Destructor - destructor Destroy; override; - - // Opens the COM port and takes of it. Returns false if something - // goes wrong. - function Connect: boolean; - // Closes the COM port and releases control of it - procedure Disconnect; - // Returns true if COM port has been opened - function Connected: boolean; - // Returns the current state of CTS, DSR, RING and RLSD (CD) lines. - // The function fails if the hardware does not support the control-register - // values (that is, returned set is always empty). - function GetLineStatus: TLineStatusSet; - // Returns true if polling has not been paused - function IsPolling: boolean; - // Pauses polling - procedure PausePolling; - // Re-starts polling (after pause) - procedure ContinuePolling; - // Flushes the rx/tx buffers - function FlushBuffers( inBuf, outBuf: boolean ): boolean; - // Returns number of received bytes in the RX buffer - function CountRX: integer; - // Returns the output buffer free space or 65535 if not connected - function OutFreeSpace: word; - // Sends binary data - function SendData( DataPtr: pointer; DataSize: DWORD ): DWORD; - // Sends binary data. Returns number of bytes sent. Timeout overrides - // the value specifiend in the OutputTimeout property - function SendDataEx( DataPtr: pchar; DataSize, Timeout: DWORD ): DWORD; - // Sends a byte. Returns true if the byte has been sent - function SendByte( Value: byte ): boolean; - // Sends a char. Returns true if the char has been sent - function SendChar( Value: char ): boolean; - // Sends a pascal string (NULL terminated if $H+ (default)) - function SendString( s: string ): boolean; - // Sends a C-style strings (NULL terminated) - function SendZString( s: pchar ): boolean; - // Reads binary data. Returns number of bytes read - function ReadData( DataPtr: pchar; MaxDataSize: DWORD ): DWORD; - // Reads a byte. Returns true if the byte has been read - function ReadByte( var Value: byte ): boolean; - // Reads a char. Returns true if char has been read - function ReadChar( var Value: char ): boolean; - // Set DTR line high (onOff=TRUE) or low (onOff=FALSE). - // You must not use HW handshaking. - procedure ToggleDTR( onOff: boolean ); - // Set RTS line high (onOff=TRUE) or low (onOff=FALSE). - // You must not use HW handshaking. - procedure ToggleRTS( onOff: boolean ); - - // Make the Handle of the COM port public (for TAPI...) [read/write] - property Handle: HFILE read FHandle write SetHandle; - published - // # of the COM Port to use ( or pnCustom for port by name ) - property Port: TPortNumber read FPort write SetPort default pnCOM2; - // Name of COM port - property PortName: string read FPortName write SetPortName; - // Speed ( Baud Rate ) - property BaudRate: TBaudRate read FBaudRate write SetBaudRate default br9600; - // Speed ( Actual Baud Rate value ) - property BaudRateValue: DWORD read FBaudRateValue write SetBaudRateValue default 9600; - // Data bits to use (5..8, for the 8250 the use of 5 data bits with 2 stop - // bits is an invalid combination, as is 6, 7, or 8 data bits with 1.5 stop - // bits) - property DataBits: TDataBits read FDataBits write SetDataBits default db8BITS; - // Stop bits to use (1, 1.5, 2) - property StopBits: TStopBits read FStopBits write SetStopBits default sb1BITS; - // Kind of Parity to use (none,odd,even,mark,space) - property Parity: TParity read FParity write SetParity default ptNONE; - // Kind of Hardware Flow Control to use: - // hfNONE none - // hfNONERTSON no flow control but keep RTS line on - // hfRTSCTS Request-To-Send/Clear-To-Send - property HwFlow: THwFlowControl read FHwFlow write SetHwFlowControl default hfNONERTSON; - // Kind of Software Flow Control to use: - // sfNONE none - // sfXONXOFF XON/XOFF - property SwFlow: TSwFlowControl read FSwFlow write SetSwFlowControl default sfNONE; - // Input Buffer size ( suggested - driver might ignore this setting ! ) - property InBufSize: DWORD read FInBufSize write SetInBufSize default 2048; - // Output Buffer size ( suggested - driver usually ignores this setting ! ) - property OutBufSize: DWORD read FOutBufSize write SetOutBufSize default 2048; - // RX packet size ( this value must be less than InBufSize ) - // A value <= 0 means "no packet mode" ( i.e. standard mode enabled ) - property PacketSize: smallint read FPacketSize write SetPacketSize default -1; - // Timeout (ms) for a complete packet (in RX) - property PacketTimeout: integer read FPacketTimeout write SetPacketTimeout default -1; - // What to do with incomplete packets (in RX) - property PacketMode: TPacketMode read FPacketMode write FPacketMode default pmDiscard; - // ms of delay between COM port pollings - property PollingDelay: word read FPollingDelay write SetPollingDelay default 50; - // Set to TRUE to enable DTR line on connect and to leave it on until disconnect. - // Set to FALSE to disable DTR line on connect. - property EnableDTROnOpen: boolean read FEnableDTROnOpen write FEnableDTROnOpen default true; - // Output timeout (milliseconds) - property OutputTimeout: word read FOutputTimeOut write FOutputTimeout default 500; - // Input timeout (milliseconds) - property InputTimeout: DWORD read FInputTimeOut write FInputTimeout default 200; - // Set to TRUE to prevent hangs when no device connected or device is OFF - property CheckLineStatus: boolean read FCkLineStatus write FCkLineStatus default false; - // Event to raise when there is data available (input buffer has data) - // (called only if PacketSize <= 0) - property OnReceiveData: TReceiveDataEvent read FOnReceiveData write FOnReceiveData; - // Event to raise when there is data packet available (called only if PacketSize > 0) - property OnReceivePacket: TReceivePacketEvent read FOnReceivePacket write FOnReceivePacket; - end; - -function BaudRateOf( bRate: TBaudRate ): DWORD; -function DelayForRX( bRate: TBaudRate; DataSize: DWORD ): DWORD; - -implementation - -const - Win32BaudRates: array[br110..br256000] of DWORD = - ( CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600, - CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200, - CBR_128000, CBR_256000 ); - -const - dcb_Binary = $00000001; - dcb_ParityCheck = $00000002; - dcb_OutxCtsFlow = $00000004; - dcb_OutxDsrFlow = $00000008; - dcb_DtrControlMask = $00000030; - dcb_DtrControlDisable = $00000000; - dcb_DtrControlEnable = $00000010; - dcb_DtrControlHandshake = $00000020; - dcb_DsrSensivity = $00000040; - dcb_TXContinueOnXoff = $00000080; - dcb_OutX = $00000100; - dcb_InX = $00000200; - dcb_ErrorChar = $00000400; - dcb_NullStrip = $00000800; - dcb_RtsControlMask = $00003000; - dcb_RtsControlDisable = $00000000; - dcb_RtsControlEnable = $00001000; - dcb_RtsControlHandshake = $00002000; - dcb_RtsControlToggle = $00003000; - dcb_AbortOnError = $00004000; - dcb_Reserveds = $FFFF8000; - -function GetWinPlatform: string; -var ov: TOSVERSIONINFO; -begin - ov.dwOSVersionInfoSize := sizeof(ov); - if GetVersionEx( ov ) then - begin - case ov.dwPlatformId of - VER_PLATFORM_WIN32s: // Win32s on Windows 3.1 - Result := 'W32S'; - VER_PLATFORM_WIN32_WINDOWS: // Win32 on Windows 95/98 - Result := 'W95'; - VER_PLATFORM_WIN32_NT: // Windows NT - Result := 'WNT'; - end; - end - else - Result := '??'; -end; - -function GetWinVersion: DWORD; -var ov: TOSVERSIONINFO; -begin - ov.dwOSVersionInfoSize := sizeof(ov); - if GetVersionEx( ov ) then - Result := MAKELONG( ov.dwMinorVersion, ov.dwMajorVersion ) - else - Result := $00000000; -end; - -function BaudRateOf( bRate: TBaudRate ): DWORD; -begin - if bRate = brCustom then - Result := 0 - else - Result := Win32BaudRates[ bRate ]; -end; - -function DelayForRX( bRate: TBaudRate; DataSize: DWORD ): DWORD; -begin - Result := round( DataSize / (BaudRateOf(bRate) / 10) * 1000 ); -end; - -constructor TCommPortDriver.Create( AOwner: TComponent ); -begin - inherited Create( AOwner ); - // Initialize to default values ----------------------- - // not canceled - FCancel := false; - // Not connected - FHandle := INVALID_HANDLE_VALUE; - // COM 2 - FPort := pnCOM2; - FPortName := '\\.\COM2'; - // 9600 bauds - FBaudRate := br9600; - FBaudRateValue := BaudRateOf( br9600 ); - // 8 data bits - FDataBits := db8BITS; - // 1 stop bit - FStopBits := sb1BITS; - // no parity - FParity := ptNONE; - // No hardware flow control but RTS on - FHwFlow := hfNONERTSON; - // No software flow control - FSwFlow := sfNONE; - // Input buffer of 2048 bytes - FInBufSize := 2048; - // Output buffer of 2048 bytes - FOutBufSize := 2048; - // Don't pack data - FPacketSize := -1; - // Packet timeout disabled - FPacketTimeout := -1; - // Discard incomplete packets - FPacketMode := pmDiscard; - // Poll COM port every 50ms - FPollingDelay := 50; - // Output timeout of 500ms - FOutputTimeout := 500; - // Timeout for ReadData(), 200ms - FInputTimeout := 200; - // DTR high on connect - FEnableDTROnOpen := true; - // Time not valid ( used by the packing routines ) - FFirstByteOfPacketTime := DWORD(-1); - // Don't check of off-line devices - FCkLineStatus := false; - // Init number of RX polling timer pauses - not paused - FRXPollingPauses := 0; - // Temporary buffer for received data - FTempInBuffer := AllocMem( FInBufSize ); - // Allocate a window handle to catch timer's notification messages - if not (csDesigning in ComponentState) then - FNotifyWnd := AllocateHWnd( TimerWndProc ); -end; - -destructor TCommPortDriver.Destroy; -begin - // Be sure to release the COM port - Disconnect; - // Free the temporary buffer - FreeMem( FTempInBuffer, FInBufSize ); - // Destroy the timer's window - if not (csDesigning in ComponentState) then - DeallocateHWnd( FNotifyWnd ); - // Call inherited destructor - inherited Destroy; -end; - -// The COM port handle made public and writeable. -// This lets you connect to external opened com port. -// Setting ComPortHandle to INVALID_PORT_HANDLE acts as Disconnect. -procedure TCommPortDriver.SetHandle( Value: HFILE ); -begin - // If same COM port then do nothing - if FHandle = Value then - exit; - // If value is RELEASE_NOCLOSE_PORT then stop controlling the COM port - // without closing in - if Value = RELEASE_NOCLOSE_PORT then - begin - // Stop the timer - if Connected then - KillTimer( FNotifyWnd, 1 ); - // No more connected - FHandle := INVALID_HANDLE_VALUE; - end - else - begin - // Disconnect - Disconnect; - // If Value is INVALID_HANDLE_VALUE then exit now - if Value = INVALID_HANDLE_VALUE then - exit; - // Set COM port handle - FHandle := Value; - // Start the timer ( used for polling ) - SetTimer( FNotifyWnd, 1, FPollingDelay, nil ); - end; -end; - -// Selects the COM port to use -procedure TCommPortDriver.SetPort( Value: TPortNumber ); -begin - // Be sure we are not using any COM port - if Connected then - exit; - // Change COM port - FPort := Value; - // Update the port name - if FPort <> pnCustom then - FPortName := Format( '\\.\COM%d', [ord(FPort)] ); -end; - -// Sets the port name -procedure TCommPortDriver.SetPortName( Value: string ); -begin - // Be sure we are not using any COM port - if Connected then - exit; - // Change COM port - FPort := pnCustom; - // Update the port name - FPortName := Value; -end; - -// Selects the baud rate -procedure TCommPortDriver.SetBaudRate( Value: TBaudRate ); -begin - // Set new COM speed - FBaudRate := Value; - if FBaudRate <> brCustom then - FBaudRateValue := BaudRateOf( FBaudRate ); - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Selects the baud rate ( actual baud rate value ) -procedure TCommPortDriver.SetBaudRateValue( Value: DWORD ); -begin - // Set new COM speed - FBaudRate := brCustom; - FBaudRateValue := Value; - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Selects the number of data bits -procedure TCommPortDriver.SetDataBits( Value: TDataBits ); -begin - // Set new data bits - FDataBits := Value; - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Selects the number of stop bits -procedure TCommPortDriver.SetStopBits( Value: TStopBits ); -begin - // Set new stop bits - FStopBits := Value; - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Selects the kind of parity -procedure TCommPortDriver.SetParity( Value: TParity ); -begin - // Set new parity - FParity := Value; - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Selects the kind of hardware flow control -procedure TCommPortDriver.SetHwFlowControl( Value: THwFlowControl ); -begin - // Set new hardware flow control - FHwFlow := Value; - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Selects the kind of software flow control -procedure TCommPortDriver.SetSwFlowControl( Value: TSwFlowControl ); -begin - // Set new software flow control - FSwFlow := Value; - // Apply changes - if Connected then - ApplyCOMSettings; -end; - -// Sets the RX buffer size -procedure TCommPortDriver.SetInBufSize( Value: DWORD ); -begin - // Do nothing if connected - if Connected then - exit; - // Free the temporary input buffer - FreeMem( FTempInBuffer, FInBufSize ); - // Set new input buffer size - if Value > 8192 then - Value := 8192 - else if Value < 128 then - Value := 128; - FInBufSize := Value; - // Allocate the temporary input buffer - FTempInBuffer := AllocMem( FInBufSize ); - // Adjust the RX packet size - SetPacketSize( FPacketSize ); -end; - -// Sets the TX buffer size -procedure TCommPortDriver.SetOutBufSize( Value: DWORD ); -begin - // Do nothing if connected - if Connected then - exit; - // Set new output buffer size - if Value > 8192 then - Value := 8192 - else if Value < 128 then - Value := 128; - FOutBufSize := Value; -end; - -// Sets the size of incoming packets -procedure TCommPortDriver.SetPacketSize( Value: smallint ); -begin - // PackeSize <= 0 if data isn't to be 'packetized' - if Value <= 0 then - FPacketSize := -1 - // If the PacketSize if greater than then RX buffer size then - // increase the RX buffer size - else if DWORD(Value) > FInBufSize then - begin - FPacketSize := Value; - SetInBufSize( FPacketSize ); - end; -end; - -// Sets the timeout for incoming packets -procedure TCommPortDriver.SetPacketTimeout( Value: integer ); -begin - // PacketTimeout <= 0 if packet timeout is to be disabled - if Value < 1 then - FPacketTimeout := -1 - // PacketTimeout cannot be less than polling delay + some extra ms - else if Value < FPollingDelay then - FPacketTimeout := FPollingDelay + (FPollingDelay*40) div 100; -end; - -// Sets the delay between polling checks -procedure TCommPortDriver.SetPollingDelay( Value: word ); -begin - // Make it greater than 4 ms - if Value < 5 then - Value := 5; - // If new delay is not equal to previous value... - if Value <> FPollingDelay then - begin - // Stop the timer - if Connected then - KillTimer( FNotifyWnd, 1 ); - // Store new delay value - FPollingDelay := Value; - // Restart the timer - if Connected then - SetTimer( FNotifyWnd, 1, FPollingDelay, nil ); - // Adjust the packet timeout - SetPacketTimeout( FPacketTimeout ); - end; -end; - -// Apply COM settings -function TCommPortDriver.ApplyCOMSettings: boolean; -var dcb: TDCB; -begin - // Do nothing if not connected - Result := false; - if not Connected then - exit; - - // ** Setup DCB (Device Control Block) fields ****************************** - - // Clear all - fillchar( dcb, sizeof(dcb), 0 ); - // DCB structure size - dcb.DCBLength := sizeof(dcb); - // Baud rate - dcb.BaudRate := FBaudRateValue; - // Set fBinary: Win32 does not support non binary mode transfers - // (also disable EOF check) - dcb.Flags := dcb_Binary; - // Enables the DTR line when the device is opened and leaves it on - if EnableDTROnOpen then - dcb.Flags := dcb.Flags or dcb_DtrControlEnable; - // Kind of hw flow control to use - case FHwFlow of - // No hw flow control - hfNONE:; - // No hw flow control but set RTS high and leave it high - hfNONERTSON: - dcb.Flags := dcb.Flags or dcb_RtsControlEnable; - // RTS/CTS (request-to-send/clear-to-send) flow control - hfRTSCTS: - dcb.Flags := dcb.Flags or dcb_OutxCtsFlow or dcb_RtsControlHandshake; - end; - // Kind of sw flow control to use - case FSwFlow of - // No sw flow control - sfNONE:; - // XON/XOFF sw flow control - sfXONXOFF: - dcb.Flags := dcb.Flags or dcb_OutX or dcb_InX; - end; - // Set XONLim: specifies the minimum number of bytes allowed in the input - // buffer before the XON character is sent (or CTS is set). - if (GetWinPlatform = 'WNT') and (GetWinVersion >= $00040000) then - begin - // WinNT 4.0 + Service Pack 3 needs XONLim to be less than or - // equal to 4096 bytes. Win95/98 doesn't have such limit. - if FInBufSize div 4 > 4096 then - dcb.XONLim := 4096 - else - dcb.XONLim := FInBufSize div 4; - end - else - dcb.XONLim := FInBufSize div 4; - // Specifies the maximum number of bytes allowed in the input buffer before - // the XOFF character is sent (or CTS is set low). The maximum number of bytes - // allowed is calculated by subtracting this value from the size, in bytes, of - // the input buffer. - dcb.XOFFLim := dcb.XONLim; - // How many data bits to use - dcb.ByteSize := 5 + ord(FDataBits); - // Kind of parity to use - dcb.Parity := ord(FParity); - // How many stop bits to use - dcb.StopBits := ord(FStopbits); - // XON ASCII char - DC1, Ctrl-Q, ASCII 17 - dcb.XONChar := #17; - // XOFF ASCII char - DC3, Ctrl-S, ASCII 19 - dcb.XOFFChar := #19; - - // Apply new settings - Result := SetCommState( FHandle, dcb ); - if not Result then - exit; - // Flush buffers - Result := FlushBuffers( true, true ); - if not Result then - exit; - // Setup buffers size - Result := SetupComm( FHandle, FInBufSize, FOutBufSize ); -end; - -function TCommPortDriver.Connect: boolean; -var tms: TCOMMTIMEOUTS; -begin - // not canceled - FCancel := false; - - // Do nothing if already connected - Result := Connected; - if Result then - exit; - // Open the COM port - FHandle := CreateFile( pchar(FPortName), - GENERIC_READ or GENERIC_WRITE, - 0, // Not shared - nil, // No security attributes - OPEN_EXISTING, - FILE_ATTRIBUTE_NORMAL, - 0 // No template - ) ; - Result := Connected; - if not Result then - exit; - // Apply settings - Result := ApplyCOMSettings; - if not Result then - begin - Disconnect; - exit; - end; - // Set ReadIntervalTimeout: Specifies the maximum time, in milliseconds, - // allowed to elapse between the arrival of two characters on the - // communications line. - // We disable timeouts because we are polling the com port! - tms.ReadIntervalTimeout := 1; - // Set ReadTotalTimeoutMultiplier: Specifies the multiplier, in milliseconds, - // used to calculate the total time-out period for read operations. - tms.ReadTotalTimeoutMultiplier := 0; - // Set ReadTotalTimeoutConstant: Specifies the constant, in milliseconds, - // used to calculate the total time-out period for read operations. - tms.ReadTotalTimeoutConstant := 1; - // Set WriteTotalTimeoutMultiplier: Specifies the multiplier, in milliseconds, - // used to calculate the total time-out period for write operations. - tms.WriteTotalTimeoutMultiplier := 0; - // Set WriteTotalTimeoutConstant: Specifies the constant, in milliseconds, - // used to calculate the total time-out period for write operations. - tms.WriteTotalTimeoutConstant := 10; - // Apply timeouts - SetCommTimeOuts( FHandle, tms ); - // Start the timer (used for polling) - SetTimer( FNotifyWnd, 1, FPollingDelay, nil ); -end; - -procedure TCommPortDriver.Disconnect; -begin - // not canceled - FCancel := true; - - - if Connected then - begin - // Stop the timer (used for polling) - KillTimer( FNotifyWnd, 1 ); - // Release the COM port - CloseHandle( FHandle ); - // No more connected - FHandle := INVALID_HANDLE_VALUE; - end; -end; - -// Returns true if connected -function TCommPortDriver.Connected: boolean; -begin - Result := FHandle <> INVALID_HANDLE_VALUE; -end; - -// Returns CTS, DSR, RING and RLSD (CD) signals status -function TCommPortDriver.GetLineStatus: TLineStatusSet; -var dwS: DWORD; -begin - Result := []; - if not Connected then - exit; - // Retrieves modem control-register values. - // The function fails if the hardware does not support the control-register - // values. - if not GetCommModemStatus( FHandle, dwS ) then - exit; - if dwS and MS_CTS_ON <> 0 then Result := Result + [lsCTS]; - if dwS and MS_DSR_ON <> 0 then Result := Result + [lsDSR]; - if dwS and MS_RING_ON <> 0 then Result := Result + [lsRING]; - if dwS and MS_RLSD_ON <> 0 then Result := Result + [lsCD]; -end; - -// Returns true if polling has not been paused -function TCommPortDriver.IsPolling: boolean; -begin - Result := FRXPollingPauses <= 0; -end; - -// Pauses polling -procedure TCommPortDriver.PausePolling; -begin - // Inc. RX polling pauses counter - inc( FRXPollingPauses ); -end; - -// Re-starts polling (after pause) -procedure TCommPortDriver.ContinuePolling; -begin - // Dec. RX polling pauses counter - dec( FRXPollingPauses ); -end; - -// Flush rx/tx buffers -function TCommPortDriver.FlushBuffers( inBuf, outBuf: boolean ): boolean; -var dwAction: DWORD; -begin - // Do nothing if not connected - Result := false; - if not Connected then - exit; - // Flush the RX data buffer - dwAction := 0; - if outBuf then - dwAction := dwAction or PURGE_TXABORT or PURGE_TXCLEAR; - // Flush the TX data buffer - if inBuf then - dwAction := dwAction or PURGE_RXABORT or PURGE_RXCLEAR; - Result := PurgeComm( FHandle, dwAction ); - // Used by the RX packet mechanism - if Result then - FFirstByteOfPacketTime := DWORD(-1); -end; - -// Returns number of received bytes in the RX buffer -function TCommPortDriver.CountRX: integer; -var stat: TCOMSTAT; - errs: DWORD; -begin - // Do nothing if port has not been opened - Result := 65535; - if not Connected then - exit; - // Get count - ClearCommError( FHandle, errs, @stat ); - Result := stat.cbInQue; -end; - -// Returns the output buffer free space or 65535 if not connected -function TCommPortDriver.OutFreeSpace: word; -var stat: TCOMSTAT; - errs: DWORD; -begin - if not Connected then - Result := 65535 - else - begin - ClearCommError( FHandle, errs, @stat ); - Result := FOutBufSize - stat.cbOutQue; - end; -end; - -// Sends binary data. Returns number of bytes sent. Timeout overrides -// the value specifiend in the OutputTimeout property -function TCommPortDriver.SendDataEx( DataPtr: pchar; DataSize, Timeout: DWORD ): DWORD; -var nToSend, nSent, t1: DWORD; -begin - // Do nothing if port has not been opened - Result := 0; - if not Connected then - exit; - // Current time - t1 := GetTickCount; - // Loop until all data sent or timeout occurred - while DataSize > 0 do - begin - // Get TX buffer free space - nToSend := OutFreeSpace; - // If output buffer has some free space... - if nToSend > 0 then - begin - // Check signals - if FCkLineStatus and (GetLineStatus = []) then - exit; - // Don't send more bytes than we actually have to send - if nToSend > DataSize then - nToSend := DataSize; - // Send - WriteFile( FHandle, DataPtr^, nToSend, nSent, nil ); - nSent := abs( nSent ); - if nSent > 0 then - begin - // Update number of bytes sent - Result := Result + nSent; - // Decrease the count of bytes to send - DataSize := DataSize - nSent; - // Inc. data pointer - DataPtr := DataPtr + nSent; - // Get current time - t1 := GetTickCount; - // Continue. This skips the time check below (don't stop - // trasmitting if the Timeout is set too low) - continue; - end; - end; - // Buffer is full. If we are waiting too long then exit - if DWORD(GetTickCount-t1) > Timeout then - exit; - end; -end; - -// Send data (breaks the data in small packets if it doesn't fit in the output -// buffer) -function TCommPortDriver.SendData( DataPtr: pointer; DataSize: DWORD ): DWORD; -begin - Result := SendDataEx( DataPtr, DataSize, FOutputTimeout ); -end; - -// Sends a byte. Returns true if the byte has been sent -function TCommPortDriver.SendByte( Value: byte ): boolean; -begin - Result := SendData( @Value, 1 ) = 1; -end; - -// Sends a char. Returns true if the char has been sent -function TCommPortDriver.SendChar( Value: char ): boolean; -begin - Result := SendData( @Value, 1 ) = 1; -end; - -// Sends a pascal string (NULL terminated if $H+ (default)) -function TCommPortDriver.SendString( s: string ): boolean; -var len: DWORD; -begin - len := length( s ); - {$IFOPT H+} // New syle pascal string (NULL terminated) - Result := SendData( pchar(s), len ) = len; - {$ELSE} // Old style pascal string (s[0] = length) - Result := SendData( pchar(@s[1]), len ) = len; - {$ENDIF} -end; - -// Sends a C-style string (NULL terminated) -function TCommPortDriver.SendZString( s: pchar ): boolean; -var len: DWORD; -begin - len := strlen( s ); - Result := SendData( s, len ) = len; -end; - -// Reads binary data. Returns number of bytes read -function TCommPortDriver.ReadData( DataPtr: pchar; MaxDataSize: DWORD ): DWORD; -var nToRead, nRead, t1: DWORD; -begin - // Do nothing if port has not been opened - Result := 0; - if not Connected then - exit; - // Pause polling - PausePolling; - // Current time - t1 := GetTickCount; - // Loop until all requested data read or timeout occurred - while MaxDataSize > 0 do - begin - Application.ProcessMessages; // ##Vg process these messages - - if FCancel then exit; - - // Get data bytes count in RX buffer - nToRead := CountRX; - // If input buffer has some data... - if nToRead > 0 then - begin - // Don't read more bytes than we actually have to read - if nToRead > MaxDataSize then - nToRead := MaxDataSize; - // Read - ReadFile( FHandle, DataPtr^, nToRead, nRead, nil ); - // Update number of bytes read - Result := Result + nRead; - // Decrease the count of bytes to read - MaxDataSize := MaxDataSize - nRead; - // Inc. data pointer - DataPtr := DataPtr + nRead; - // Get current time - t1 := GetTickCount; - // Continue. This skips the time check below (don't stop - // reading if the FInputTimeout is set too low) - continue; - end; - // Buffer is empty. If we are waiting too long then exit - if (GetTickCount-t1) > FInputTimeout then - break; - end; - // Continue polling - ContinuePolling; -end; - -// Reads a byte. Returns true if the byte has been read -function TCommPortDriver.ReadByte( var Value: byte ): boolean; -begin - Result := ReadData( @Value, 1 ) = 1; -end; - -// Reads a char. Returns true if char has been read -function TCommPortDriver.ReadChar( var Value: char ): boolean; -begin - Result := ReadData( @Value, 1 ) = 1; -end; - -// Set DTR line high (onOff=TRUE) or low (onOff=FALSE). -// You must not use HW handshaking. -procedure TCommPortDriver.ToggleDTR( onOff: boolean ); -const funcs: array[boolean] of integer = (CLRDTR,SETDTR); -begin - if Connected then - EscapeCommFunction( FHandle, funcs[onOff] ); -end; - -// Set RTS line high (onOff=TRUE) or low (onOff=FALSE). -// You must not use HW handshaking. -procedure TCommPortDriver.ToggleRTS( onOff: boolean ); -const funcs: array[boolean] of integer = (CLRRTS,SETRTS); -begin - if Connected then - EscapeCommFunction( FHandle, funcs[onOff] ); -end; - -// COM port polling proc -procedure TCommPortDriver.TimerWndProc( var msg: TMessage ); -var nRead, nToRead, dummy: DWORD; - comStat: TCOMSTAT; -begin - if (msg.Msg = WM_TIMER) and Connected then - begin - // Do nothing if RX polling has been paused - if FRXPollingPauses > 0 then - exit; - // If PacketSize is > 0 then raise the OnReceiveData event only if the RX - // buffer has at least PacketSize bytes in it. - ClearCommError( FHandle, dummy, @comStat ); - if FPacketSize > 0 then - begin - // Complete packet received ? - if DWORD(comStat.cbInQue) >= DWORD(FPacketSize) then - begin - repeat - // Read the packet and pass it to the app - nRead := 0; - if ReadFile( FHandle, FTempInBuffer^, FPacketSize, nRead, nil ) then - if (nRead <> 0) and Assigned(FOnReceivePacket) then - FOnReceivePacket( Self, FTempInBuffer, nRead ); - // Adjust time - //if comStat.cbInQue >= FPacketSize then - FFirstByteOfPacketTime := FFirstByteOfPacketTime + - DelayForRX( FBaudRate, FPacketSize ); - comStat.cbInQue := comStat.cbInQue - WORD(FPacketSize); - if comStat.cbInQue = 0 then - FFirstByteOfPacketTime := DWORD(-1); - until DWORD(comStat.cbInQue) < DWORD(FPacketSize); - // Done - exit; - end; - // Handle packet timeouts - if (FPacketTimeout > 0) and (FFirstByteOfPacketTime <> DWORD(-1)) and - (GetTickCount - FFirstByteOfPacketTime > DWORD(FPacketTimeout)) then - begin - nRead := 0; - // Read the "incomplete" packet - if ReadFile( FHandle, FTempInBuffer^, comStat.cbInQue, nRead, nil ) then - // If PacketMode is not pmDiscard then pass the packet to the app - if (FPacketMode <> pmDiscard) and (nRead <> 0) and Assigned(FOnReceivePacket) then - FOnReceivePacket( Self, FTempInBuffer, nRead ); - // Restart waiting for a packet - FFirstByteOfPacketTime := DWORD(-1); - // Done - exit; - end; - // Start time - if (comStat.cbInQue > 0) and (FFirstByteOfPacketTime = DWORD(-1)) then - FFirstByteOfPacketTime := GetTickCount; - // Done - exit; - end; - - // Standard data handling - nRead := 0; - nToRead := comStat.cbInQue; - if (nToRead > 0) and ReadFile( FHandle, FTempInBuffer^, nToRead, nRead, nil ) then - if (nRead <> 0) and Assigned(FOnReceiveData) then - FOnReceiveData( Self, FTempInBuffer, nRead ); - end - // Let Windows handle other messages - else - Msg.Result := DefWindowProc( FNotifyWnd, Msg.Msg, Msg.wParam, Msg.lParam ) ; -end; - -end. diff --git a/Host/Source/MicroBoot/interfaces/uart/CPort.inc b/Host/Source/MicroBoot/interfaces/uart/CPort.inc new file mode 100644 index 00000000..eb736695 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/uart/CPort.inc @@ -0,0 +1,227 @@ +{ ComPort Library global definitions } + +{ Fixed up for Delphi 2009 by W.Postma. } + +{$B-} +{$X+} +{$H+} + +{$IFDEF VER110} { C++ Builder 3 } + {$ObjExportAll On} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER120} { Delphi 4 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_4} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER125} { C++ Builder 4 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_4} + {$ObjExportAll On} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER130} { Delphi 5 and C++ Builder 5 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_5} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER140} { Delphi 6 and C++ Builder 6} + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_6} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER150} { Delphi 7 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_7} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER160} { Delphi 8 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_8} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER170} { Delphi 9 (2005) } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2005} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER180} { Delphi 10 (2006) } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2006_OR_HIGHER} + {$DEFINE DELPHI_2006} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + +{$IFDEF VER185} { Delphi 11 - 2007 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2006_OR_HIGHER} + {$DEFINE DELPHI_2007_OR_HIGHER} + {$DEFINE DELPHI_2007} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$IFDEF BCB} + {$DEFINE BCB11} + {$ObjExportAll On} + {$ENDIF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + + +{$IFDEF VER190} { Delphi 12 2008 } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2006_OR_HIGHER} + {$DEFINE DELPHI_2007_OR_HIGHER} + {$DEFINE DELPHI_2008_OR_HIGHER} + {$DEFINE DELPHI_2008} + {$DEFINE DELPHI_UNICODE} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + + + +{$IFDEF VER200} { Delphi 14 2009 UNICODE } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2006_OR_HIGHER} + {$DEFINE DELPHI_2007_OR_HIGHER} + {$DEFINE DELPHI_2008_OR_HIGHER} + {$DEFINE DELPHI_2009_OR_HIGHER} + {$DEFINE DELPHI_2009} + {$DEFINE DELPHI_UNICODE} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + + + + +{$IFDEF VER210} { Delphi 15 XE 2010 UNICODE } + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2006_OR_HIGHER} + {$DEFINE DELPHI_2007_OR_HIGHER} + {$DEFINE DELPHI_2008_OR_HIGHER} + {$DEFINE DELPHI_2009_OR_HIGHER} + {$DEFINE DELPHI_2010_OR_HIGHER} + {$DEFINE DELPHI_2010} + {$DEFINE DELPHI_UNICODE} + {$IFDEF BCBNOTDELPHI} + {$ObjExportAll On} + {$ENDIF} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} + {$DEFINE VER_RECOGNIZED} +{$ENDIF} + + +{... Lets try to make it work, for Delphi 2011 and later, right now...} +{$IFNDEF VER_RECOGNIZED} + {$DEFINE DELPHI_4_OR_HIGHER} + {$DEFINE DELPHI_5_OR_HIGHER} + {$DEFINE DELPHI_6_OR_HIGHER} + {$DEFINE DELPHI_7_OR_HIGHER} + {$DEFINE DELPHI_8_OR_HIGHER} + {$DEFINE DELPHI_2005_OR_HIGHER} + {$DEFINE DELPHI_2006_OR_HIGHER} + {$DEFINE DELPHI_2007_OR_HIGHER} + {$DEFINE DELPHI_2009_OR_HIGHER} + {$DEFINE DELPHI_2010_OR_HIGHER} + {$DEFINE DELPHI_UNICODE} + {$WARN UNSAFE_TYPE OFF} + {$WARN UNSAFE_CODE OFF} + {$WARN UNSAFE_CAST OFF} +{$ENDIF} + + +{$UNDEF VER_RECOGNIZED} + diff --git a/Host/Source/MicroBoot/interfaces/uart/CPort.pas b/Host/Source/MicroBoot/interfaces/uart/CPort.pas new file mode 100644 index 00000000..286cbcc1 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/uart/CPort.pas @@ -0,0 +1,3652 @@ +(****************************************************** + * ComPort Library ver. 4.11 * + * for Delphi 5, 6, 7, 2007-2010,XE and * + * C++ Builder 3, 4, 5, 6 * + * written by Dejan Crnila, 1998 - 2002 * + * maintained by Lars B. Dybdahl, 2003 * + * Homepage: http://comport.sf.net/ * + * * + * Brian Gochnauer Oct 2010 * + * Removed ansi references for backward compat * + * Made unicode ready * + *****************************************************) + + +unit CPort; +{$Warnings OFF} +{$I CPort.inc} +{$DEFINE No_Dialogs} //removes forms setup/config code +interface + +uses + Windows, Messages, Classes, SysUtils, IniFiles, Registry, Types; + +type + TComExceptions = ( CE_OpenFailed , CE_WriteFailed , + CE_ReadFailed , CE_InvalidAsync , + CE_PurgeFailed , CE_AsyncCheck , + CE_SetStateFailed , CE_TimeoutsFailed , + CE_SetupComFailed , CE_ClearComFailed , + CE_ModemStatFailed , CE_EscapeComFailed , + CE_TransmitFailed , CE_ConnChangeProp , + CE_EnumPortsFailed , CE_StoreFailed , + CE_LoadFailed , CE_RegFailed , + CE_LedStateFailed , CE_ThreadCreated , + CE_WaitFailed , CE_HasLink , + CE_RegError , CEPortNotOpen ); + + + + + // various types + TPort = string; + TBaudRate = (brCustom, br110, br300, br600, br1200, br2400, br4800, br9600, br14400, + br19200, br38400, br56000, br57600, br115200, br128000, br256000); + TStopBits = (sbOneStopBit, sbOne5StopBits, sbTwoStopBits); + TDataBits = (dbFive, dbSix, dbSeven, dbEight); + TParityBits = (prNone, prOdd, prEven, prMark, prSpace); + TDTRFlowControl = (dtrDisable, dtrEnable, dtrHandshake); + TRTSFlowControl = (rtsDisable, rtsEnable, rtsHandshake, rtsToggle); + TFlowControl = (fcHardware, fcSoftware, fcNone, fcCustom); + TComEvent = (evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, evCTS, evDSR, evError, evRLSD, evRx80Full); + TComEvents = set of TComEvent; + TComSignal = (csCTS, csDSR, csRing, csRLSD); + TComSignals = set of TComSignal; + TComError = (ceFrame, ceRxParity, ceOverrun, ceBreak, ceIO, ceMode, ceRxOver, ceTxFull); + TComErrors = set of TComError; + TSyncMethod = (smThreadSync, smWindowSync, smNone); + TStoreType = (stRegistry, stIniFile); + TStoredProp = (spBasic, spFlowControl, spBuffer, spTimeouts, spParity, spOthers); + TStoredProps = set of TStoredProp; + TComLinkEvent = (leConn, leCTS, leDSR, leRLSD, leRing, leRx, leTx, leTxEmpty, leRxFlag); + TRxCharEvent = procedure(Sender: TObject; Count: Integer) of object; + TRxBufEvent = procedure(Sender: TObject; const Buffer; Count: Integer) of object; + TComErrorEvent = procedure(Sender: TObject; Errors: TComErrors) of object; + TComSignalEvent = procedure(Sender: TObject; OnOff: Boolean) of object; + TComExceptionEvent = procedure(Sender:TObject; + TComException:TComExceptions; ComportMessage:String; + WinError:Int64; WinMessage:String) of object; + + // types for asynchronous calls + TOperationKind = (okWrite, okRead); + TAsync = record + Overlapped: TOverlapped; + Kind: TOperationKind; + Data: Pointer; + Size: Integer; + end; + PAsync = ^TAsync; + + {$IFNDEF Unicode} + UnicodeString = Widestring; + {$ENDIF} + + // TComPort component and asistant classes + TCustomComPort = class; // forward declaration + + // class that links TCustomComPort events to other components + TComLink = class + private + FOnConn: TComSignalEvent; + FOnRxBuf: TRxBufEvent; + FOnTxBuf: TRxBufEvent; + FOnTxEmpty: TNotifyEvent; + FOnRxFlag: TNotifyEvent; + FOnCTSChange: TComSignalEvent; + FOnDSRChange: TComSignalEvent; + FOnRLSDChange: TComSignalEvent; + FOnRing: TNotifyEvent; + FOnTx: TComSignalEvent; + FOnRx: TComSignalEvent; + public + property OnConn: TComSignalEvent read FOnConn write FOnConn; + property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf; + property OnTxBuf: TRxBufEvent read FOnTxBuf write FOnTxBuf; + property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty; + property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag; + property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange; + property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange; + property OnRLSDChange: TComSignalEvent read FOnRLSDChange write FOnRLSDChange; + property OnRing: TNotifyEvent read FOnRing write FOnRing; + property OnTx: TComSignalEvent read FOnTx write FOnTx; + property OnRx: TComSignalEvent read FOnRx write FOnRx; + end; + + // thread for background monitoring of port events + TComThread = class(TThread) + private + FComPort: TCustomComPort; + FStopEvent: THandle; + FEvents: TComEvents; + protected + procedure DispatchComMsg; + procedure DoEvents; + procedure Execute; override; + procedure SendEvents; + procedure Stop; + public + constructor Create(AComPort: TCustomComPort); + destructor Destroy; override; + end; + + // timoeout properties for read/write operations + TComTimeouts = class(TPersistent) + private + FComPort: TCustomComPort; + FReadInterval: Integer; + FReadTotalM: Integer; + FReadTotalC: Integer; + FWriteTotalM: Integer; + FWriteTotalC: Integer; + procedure SetComPort(const AComPort: TCustomComPort); + procedure SetReadInterval(const Value: Integer); + procedure SetReadTotalM(const Value: Integer); + procedure SetReadTotalC(const Value: Integer); + procedure SetWriteTotalM(const Value: Integer); + procedure SetWriteTotalC(const Value: Integer); + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + property ComPort: TCustomComPort read FComPort; + published + property ReadInterval: Integer read FReadInterval write SetReadInterval default -1; + property ReadTotalMultiplier: Integer read FReadTotalM write SetReadTotalM default 0; + property ReadTotalConstant: Integer read FReadTotalC write SetReadTotalC default 0; + property WriteTotalMultiplier: Integer + read FWriteTotalM write SetWriteTotalM default 100; + property WriteTotalConstant: Integer + read FWriteTotalC write SetWriteTotalC default 1000; + end; + + // flow control settings + TComFlowControl = class(TPersistent) + private + FComPort: TCustomComPort; + FOutCTSFlow: Boolean; + FOutDSRFlow: Boolean; + FControlDTR: TDTRFlowControl; + FControlRTS: TRTSFlowControl; + FXonXoffOut: Boolean; + FXonXoffIn: Boolean; + FDSRSensitivity: Boolean; + FTxContinueOnXoff: Boolean; + FXonChar: Char; + FXoffChar: Char; + procedure SetComPort(const AComPort: TCustomComPort); + procedure SetOutCTSFlow(const Value: Boolean); + procedure SetOutDSRFlow(const Value: Boolean); + procedure SetControlDTR(const Value: TDTRFlowControl); + procedure SetControlRTS(const Value: TRTSFlowControl); + procedure SetXonXoffOut(const Value: Boolean); + procedure SetXonXoffIn(const Value: Boolean); + procedure SetDSRSensitivity(const Value: Boolean); + procedure SetTxContinueOnXoff(const Value: Boolean); + procedure SetXonChar(const Value: Char); + procedure SetXoffChar(const Value: Char); + procedure SetFlowControl(const Value: TFlowControl); + function GetFlowControl: TFlowControl; + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + property ComPort: TCustomComPort read FComPort; + published + property FlowControl: TFlowControl read GetFlowControl write SetFlowControl stored False; + property OutCTSFlow: Boolean read FOutCTSFlow write SetOutCTSFlow; + property OutDSRFlow: Boolean read FOutDSRFlow write SetOutDSRFlow; + property ControlDTR: TDTRFlowControl read FControlDTR write SetControlDTR; + property ControlRTS: TRTSFlowControl read FControlRTS write SetControlRTS; + property XonXoffOut: Boolean read FXonXoffOut write SetXonXoffOut; + property XonXoffIn: Boolean read FXonXoffIn write SetXonXoffIn; + property DSRSensitivity: Boolean + read FDSRSensitivity write SetDSRSensitivity default False; + property TxContinueOnXoff: Boolean + read FTxContinueOnXoff write SetTxContinueOnXoff default False; + property XonChar: Char read FXonChar write SetXonChar default #17; + property XoffChar: Char read FXoffChar write SetXoffChar default #19; + end; + + // parity settings + TComParity = class(TPersistent) + private + FComPort: TCustomComPort; + FBits: TParityBits; + FCheck: Boolean; + FReplace: Boolean; + FReplaceChar: Char; + procedure SetComPort(const AComPort: TCustomComPort); + procedure SetBits(const Value: TParityBits); + procedure SetCheck(const Value: Boolean); + procedure SetReplace(const Value: Boolean); + procedure SetReplaceChar(const Value: Char); + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + property ComPort: TCustomComPort read FComPort; + published + property Bits: TParityBits read FBits write SetBits; + property Check: Boolean read FCheck write SetCheck default False; + property Replace: Boolean read FReplace write SetReplace default False; + property ReplaceChar: Char read FReplaceChar write SetReplaceChar default #0; + end; + + // buffer size settings + TComBuffer = class(TPersistent) + private + FComPort: TCustomComPort; + FInputSize: Integer; + FOutputSize: Integer; + procedure SetComPort(const AComPort: TCustomComPort); + procedure SetInputSize(const Value: Integer); + procedure SetOutputSize(const Value: Integer); + protected + procedure AssignTo(Dest: TPersistent); override; + public + constructor Create; + property ComPort: TCustomComPort read FComPort; + published + property InputSize: Integer read FInputSize write SetInputSize default 1024; + property OutputSize: Integer read FOutputSize write SetOutputSize default 1024; + end; + + // main component + TCustomComPort = class(TComponent) + private + FEventThread: TComThread; + FThreadCreated: Boolean; + FHandle: THandle; + FWindow: THandle; + FUpdateCount: Integer; + FLinks: TList; + FTriggersOnRxChar: Boolean; + FEventThreadPriority: TThreadPriority; + FHasLink: Boolean; + FConnected: Boolean; + FBaudRate: TBaudRate; + FCustomBaudRate: Integer; + FPort: TPort; + FStopBits: TStopBits; + FDataBits: TDataBits; + FDiscardNull: Boolean; + FEventChar: Char; + FEvents: TComEvents; + FBuffer: TComBuffer; + FParity: TComParity; + FTimeouts: TComTimeouts; + FFlowControl: TComFlowControl; + FSyncMethod: TSyncMethod; + FStoredProps: TStoredProps; + FOnRxChar: TRxCharEvent; + FOnRxBuf: TRxBufEvent; + FOnTxEmpty: TNotifyEvent; + FOnBreak: TNotifyEvent; + FOnRing: TNotifyEvent; + FOnCTSChange: TComSignalEvent; + FOnDSRChange: TComSignalEvent; + FOnRLSDChange: TComSignalEvent; + FOnError: TComErrorEvent; + FOnRxFlag: TNotifyEvent; + FOnAfterOpen: TNotifyEvent; + FOnAfterClose: TNotifyEvent; + FOnBeforeOpen: TNotifyEvent; + FOnBeforeClose: TNotifyEvent; + FOnRx80Full : TNotifyEvent; + FOnException :TComExceptionEvent; + FCodePage : Cardinal; + function GetTriggersOnRxChar: Boolean; + procedure SetTriggersOnRxChar(const Value: Boolean); + procedure SetConnected(const Value: Boolean); + procedure SetBaudRate(const Value: TBaudRate); + procedure SetCustomBaudRate(const Value: Integer); + procedure SetPort(const Value: TPort); + procedure SetStopBits(const Value: TStopBits); + procedure SetDataBits(const Value: TDataBits); + procedure SetDiscardNull(const Value: Boolean); + procedure SetEventChar(const Value: Char); + procedure SetSyncMethod(const Value: TSyncMethod); + procedure SetEventThreadPriority(const Value: TThreadPriority); + procedure SetParity(const Value: TComParity); + procedure SetTimeouts(const Value: TComTimeouts); + procedure SetBuffer(const Value: TComBuffer); + procedure SetFlowControl(const Value: TComFlowControl); + function HasLink: Boolean; + procedure TxNotifyLink(const Buffer; Count: Integer); + procedure NotifyLink(FLinkEvent: TComLinkEvent); + procedure SendSignalToLink(Signal: TComLinkEvent; OnOff: Boolean); + procedure CheckSignals(Open: Boolean); + procedure WindowMethod(var Message: TMessage); + procedure CallAfterOpen; + procedure CallAfterClose; + procedure CallBeforeOpen; + procedure CallBeforeClose; + procedure CallRxChar; + procedure CallTxEmpty; + procedure CallBreak; + procedure CallRing; + procedure CallRxFlag; + procedure CallCTSChange; + procedure CallDSRChange; + procedure CallError; + procedure CallRLSDChange; + procedure CallRx80Full; + procedure CallException(AnException: Word; const WinError: Int64 =0); + protected + procedure Loaded; override; + procedure DoAfterClose; dynamic; + procedure DoAfterOpen; dynamic; + procedure DoBeforeClose; dynamic; + procedure DoBeforeOpen; dynamic; + procedure DoRxChar(Count: Integer); dynamic; + procedure DoRxBuf(const Buffer; Count: Integer); dynamic; + procedure DoTxEmpty; dynamic; + procedure DoBreak; dynamic; + procedure DoRing; dynamic; + procedure DoRxFlag; dynamic; + procedure DoCTSChange(OnOff: Boolean); dynamic; + procedure DoDSRChange(OnOff: Boolean); dynamic; + procedure DoError(Errors: TComErrors); dynamic; + procedure DoRLSDChange(OnOff: Boolean); dynamic; + procedure DoRx80Full; dynamic; + procedure StoreRegistry(Reg: TRegistry); virtual; + procedure StoreIniFile(IniFile: TIniFile); virtual; + procedure LoadRegistry(Reg: TRegistry); virtual; + procedure LoadIniFile(IniFile: TIniFile); virtual; + procedure CreateHandle; virtual; + procedure DestroyHandle; virtual; + procedure ApplyDCB; dynamic; + procedure ApplyTimeouts; dynamic; + procedure ApplyBuffer; dynamic; + procedure SetupComPort; virtual; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure BeginUpdate; + procedure EndUpdate; + procedure StoreSettings(StoreType: TStoreType; StoreTo: string); + procedure LoadSettings(StoreType: TStoreType; LoadFrom: string); + procedure Open; + procedure Close; + {$IFNDEF No_Dialogs}procedure ShowSetupDialog;{$ENDIF} + function InputCount: Integer; + function OutputCount: Integer; + function Signals: TComSignals; + function StateFlags: TComStateFlags; + procedure SetDTR(OnOff: Boolean); + procedure SetRTS(OnOff: Boolean); + procedure SetXonXoff(OnOff: Boolean); + procedure SetBreak(OnOff: Boolean); + procedure ClearBuffer(Input, Output: Boolean); + function LastErrors: TComErrors; + + function Write(const Buffer; Count: Integer): Integer; + function WriteStr( Str: string): Integer; + function Read(var Buffer; Count: Integer): Integer; + function ReadStr(var Str: string; Count: Integer): Integer; + function WriteAsync(const Buffer; Count: Integer; var AsyncPtr: PAsync): Integer; + function WriteStrAsync(var Str: string; var AsyncPtr: PAsync): Integer; + function ReadAsync(var Buffer; Count: Integer; var AsyncPtr: PAsync): Integer; + function ReadStrAsync(var Str: Ansistring; Count: Integer; var AsyncPtr: PAsync): Integer; + function WriteUnicodeString(const Str: Unicodestring): Integer; + function ReadUnicodeString(var Str: UnicodeString; Count: Integer): Integer; + + function WaitForAsync(var AsyncPtr: PAsync): Integer; + function IsAsyncCompleted(AsyncPtr: PAsync): Boolean; + procedure WaitForEvent(var Events: TComEvents; StopEvent: THandle; Timeout: Integer); + procedure AbortAllAsync; + procedure TransmitChar(Ch: Char); + procedure RegisterLink(AComLink: TComLink); + procedure UnRegisterLink(AComLink: TComLink); + property Handle: THandle read FHandle; + property TriggersOnRxChar: Boolean read GetTriggersOnRxChar write SetTriggersOnRxChar; + property EventThreadPriority: TThreadPriority read FEventThreadPriority write SetEventThreadPriority; + property StoredProps: TStoredProps read FStoredProps write FStoredProps; + property Connected: Boolean read FConnected write SetConnected default False; + property BaudRate: TBaudRate read FBaudRate write SetBaudRate; + property CustomBaudRate: Integer read FCustomBaudRate write SetCustomBaudRate; + property Port: TPort read FPort write SetPort; + property Parity: TComParity read FParity write SetParity; + property StopBits: TStopBits read FStopBits write SetStopBits; + property DataBits: TDataBits read FDataBits write SetDataBits; + property DiscardNull: Boolean read FDiscardNull write SetDiscardNull default False; + property EventChar: Char read FEventChar write SetEventChar default #0; + property Events: TComEvents read FEvents write FEvents; + property Buffer: TComBuffer read FBuffer write SetBuffer; + property FlowControl: TComFlowControl read FFlowControl write SetFlowControl; + property Timeouts: TComTimeouts read FTimeouts write SetTimeouts; + property SyncMethod: TSyncMethod read FSyncMethod write SetSyncMethod default smThreadSync; + property OnAfterOpen: TNotifyEvent read FOnAfterOpen write FOnAfterOpen; + property OnAfterClose: TNotifyEvent read FOnAfterClose write FOnAfterClose; + property OnBeforeOpen: TNotifyEvent read FOnBeforeOpen write FOnBeforeOpen; + property OnBeforeClose: TNotifyEvent read FOnBeforeClose write FOnBeforeClose; + property OnRxChar: TRxCharEvent read FOnRxChar write FOnRxChar; + property OnRxBuf: TRxBufEvent read FOnRxBuf write FOnRxBuf; + property OnTxEmpty: TNotifyEvent read FOnTxEmpty write FOnTxEmpty; + property OnBreak: TNotifyEvent read FOnBreak write FOnBreak; + property OnRing: TNotifyEvent read FOnRing write FOnRing; + property OnCTSChange: TComSignalEvent read FOnCTSChange write FOnCTSChange; + property OnDSRChange: TComSignalEvent read FOnDSRChange write FOnDSRChange; + property OnRLSDChange: TComSignalEvent read FOnRLSDChange write FOnRLSDChange; + property OnRxFlag: TNotifyEvent read FOnRxFlag write FOnRxFlag; + property OnError: TComErrorEvent read FOnError write FOnError; + property OnRx80Full: TNotifyEvent read FOnRx80Full write FOnRx80Full; + property OnException: TComExceptionEvent read FOnException write FOnException; + // Translate strings between ANSI charsets + property CodePage: Cardinal read FCodePage write FCodePage default 0; + end; + + // publish the properties + TComPort = class(TCustomComPort) + property Connected; + property BaudRate; + property Port; + property Parity; + property StopBits; + property DataBits; + property DiscardNull; + property EventChar; + property Events; + property Buffer; + property FlowControl; + property Timeouts; + property StoredProps; + property TriggersOnRxChar; + property SyncMethod; + property OnAfterOpen; + property OnAfterClose; + property OnBeforeOpen; + property OnBeforeClose; + property OnRxChar; + property OnRxBuf; + property OnTxEmpty; + property OnBreak; + property OnRing; + property OnCTSChange; + property OnDSRChange; + property OnRLSDChange; + property OnRxFlag; + property OnError; + property OnRx80Full; + property OnException; + property CodePage; + end; + + TComStrEvent = procedure(Sender: TObject; const Str: string) of object; + TCustPacketEvent = procedure(Sender: TObject; const Str: string; + var Pos: Integer) of object; + + // component for reading data in packets + TComDataPacket = class(TComponent) + private + FComLink: TComLink; + FComPort: TCustomComPort; + FStartString: string; + FStopString: string; + FMaxBufferSize: Integer; + FSize: Integer; + FIncludeStrings: Boolean; + FCaseInsensitive: Boolean; + FInPacket: Boolean; + FBuffer: string; + FOnPacket: TComStrEvent; + FOnDiscard: TComStrEvent; + FOnCustomStart: TCustPacketEvent; + FOnCustomStop: TCustPacketEvent; + procedure SetComPort(const Value: TCustomComPort); + procedure SetCaseInsensitive(const Value: Boolean); + procedure SetSize(const Value: Integer); + procedure SetStartString(const Value: string); + procedure SetStopString(const Value: string); + procedure RxBuf(Sender: TObject; const Buffer; Count: Integer); + procedure CheckIncludeStrings(var Str: string); + function Upper(const Str: string): string; + procedure EmptyBuffer; + function ValidStop: Boolean; + protected + procedure Notification(AComponent: TComponent; Operation: TOperation); override; + procedure DoDiscard(const Str: string); dynamic; + procedure DoPacket(const Str: string); dynamic; + procedure DoCustomStart(const Str: string; var Pos: Integer); dynamic; + procedure DoCustomStop(const Str: string; var Pos: Integer); dynamic; + procedure HandleBuffer; virtual; + property Buffer: string read FBuffer write FBuffer; + public + constructor Create(AOwner: TComponent); override; + destructor Destroy; override; + procedure AddData(const Str: string); + published + procedure ResetBuffer; + property ComPort: TCustomComPort read FComPort write SetComPort; + property CaseInsensitive: Boolean read FCaseInsensitive write SetCaseInsensitive default False; + property IncludeStrings: Boolean read FIncludeStrings write FIncludeStrings default False; + property MaxBufferSize: Integer read FMaxBufferSize write FMaxBufferSize default 1024; + property StartString: string read FStartString write SetStartString; + property StopString: string read FStopString write SetStopString; + property Size: Integer read FSize write SetSize default 0; + property OnDiscard: TComStrEvent read FOnDiscard write FOnDiscard; + property OnPacket: TComStrEvent read FOnPacket write FOnPacket; + property OnCustomStart: TCustPacketEvent read FOnCustomStart write FOnCustomStart; + property OnCustomStop: TCustPacketEvent read FOnCustomStop write FOnCustomStop; + end; + + // com port stream + TComStream = class(TStream) + private + FComPort: TCustomComPort; + public + constructor Create(AComPort: TCustomComPort); + function Read(var Buffer; Count: Longint): Longint; override; + function Write(const Buffer; Count: Longint): Longint; override; + function Seek(Offset: Longint; Origin: Word): Longint; override; + end; + + // exception class for ComPort Library errors + EComPort = class(Exception) + private + FWinCode: Integer; + FCode: Integer; + public + constructor Create(ACode: Integer; AWinCode: Integer); + constructor CreateNoWinCode(ACode: Integer); + property WinCode: Integer read FWinCode write FWinCode; + property Code: Integer read FCode write FCode; + end; + +// aditional procedures +procedure InitAsync(var AsyncPtr: PAsync); +procedure DoneAsync(var AsyncPtr: PAsync); +procedure EnumComPorts(Ports: TStrings); + +// conversion functions +function StrToBaudRate(Str: string): TBaudRate; +function StrToStopBits(Str: string): TStopBits; +function StrToDataBits(Str: string): TDataBits; +function StrToParity(Str: string): TParityBits; +function StrToFlowControl(Str: string): TFlowControl; +function BaudRateToStr(BaudRate: TBaudRate): string; +function StopBitsToStr(StopBits: TStopBits): string; +function DataBitsToStr(DataBits: TDataBits): string; +function ParityToStr(Parity: TParityBits): string; +function FlowControlToStr(FlowControl: TFlowControl): string; +function ComErrorsToStr(Errors:TComErrors):String; + +const + // infinite wait + WaitInfinite = Integer(INFINITE); + + // error codes + CError_OpenFailed = 1; + CError_WriteFailed = 2; + CError_ReadFailed = 3; + CError_InvalidAsync = 4; + CError_PurgeFailed = 5; + CError_AsyncCheck = 6; + CError_SetStateFailed = 7; + CError_TimeoutsFailed = 8; + CError_SetupComFailed = 9; + CError_ClearComFailed = 10; + CError_ModemStatFailed = 11; + CError_EscapeComFailed = 12; + CError_TransmitFailed = 13; + CError_ConnChangeProp = 14; + CError_EnumPortsFailed = 15; + CError_StoreFailed = 16; + CError_LoadFailed = 17; + CError_RegFailed = 18; + CError_LedStateFailed = 19; + CError_ThreadCreated = 20; + CError_WaitFailed = 21; + CError_HasLink = 22; + CError_RegError = 23; + CError_PortNotOpen = 24; + +implementation + +uses + {$IFNDEF No_Dialogs} CPortSetup, {$ENDIF} + Controls, Forms, WinSpool; + +var + // error messages + ComErrorMessages: array[1..24] of widestring; + +const + // auxilary constants used not defined in windows.pas + dcb_Binary = $00000001; + dcb_Parity = $00000002; + dcb_OutxCTSFlow = $00000004; + dcb_OutxDSRFlow = $00000008; + dcb_DTRControl = $00000030; + dcb_DSRSensivity = $00000040; + dcb_TxContinueOnXoff = $00000080; + dcb_OutX = $00000100; + dcb_InX = $00000200; + dcb_ErrorChar = $00000400; + dcb_Null = $00000800; + dcb_RTSControl = $00003000; + dcb_AbortOnError = $00004000; + + // com port window message + CM_COMPORT = WM_USER + 1; + +(***************************************** + * auxilary functions and procedures * + *****************************************) +function ComErrorsToStr(Errors:TComErrors):String; + procedure e(msg:String); + begin + if result='' then + result := msg + else + result := result+','+msg; + end; +begin + result := ''; + if ceFrame in Errors then e('Frame'); + if ceRxParity in Errors then e('Parity'); + if ceOverrun in Errors then e('Overrun'); + if ceBreak in Errors then e('Break'); + if ceIO in Errors then e('IO'); + if ceMode in Errors then e('Mode'); + if ceRxOver in Errors then e('RxOver'); + if ceTxFull in Errors then e('TxFull'); + if result = '' then + result := '' + else + result := ''; +end; + +// converts TComEvents type to Integer +function EventsToInt(const Events: TComEvents): Integer; +begin + Result := 0; + if evRxChar in Events then + Result := Result or EV_RXCHAR; + if evRxFlag in Events then + Result := Result or EV_RXFLAG; + if evTxEmpty in Events then + Result := Result or EV_TXEMPTY; + if evRing in Events then + Result := Result or EV_RING; + if evCTS in Events then + Result := Result or EV_CTS; + if evDSR in Events then + Result := Result or EV_DSR; + if evRLSD in Events then + Result := Result or EV_RLSD; + if evError in Events then + Result := Result or EV_ERR; + if evBreak in Events then + Result := Result or EV_BREAK; + if evRx80Full in Events then + Result := Result or EV_RX80FULL; +end; + +function IntToEvents(Mask: Integer): TComEvents; +begin + Result := []; + if (EV_RXCHAR and Mask) <> 0 then + Result := Result + [evRxChar]; + if (EV_TXEMPTY and Mask) <> 0 then + Result := Result + [evTxEmpty]; + if (EV_BREAK and Mask) <> 0 then + Result := Result + [evBreak]; + if (EV_RING and Mask) <> 0 then + Result := Result + [evRing]; + if (EV_CTS and Mask) <> 0 then + Result := Result + [evCTS]; + if (EV_DSR and Mask) <> 0 then + Result := Result + [evDSR]; + if (EV_RXFLAG and Mask) <> 0 then + Result := Result + [evRxFlag]; + if (EV_RLSD and Mask) <> 0 then + Result := Result + [evRLSD]; + if (EV_ERR and Mask) <> 0 then + Result := Result + [evError]; + if (EV_RX80FULL and Mask) <> 0 then + Result := Result + [evRx80Full]; +end; + +(***************************************** + * TComThread class * + *****************************************) + +// create thread +constructor TComThread.Create(AComPort: TCustomComPort); +begin + inherited Create(false); + FStopEvent := CreateEvent(nil, True, False, nil); + FComPort := AComPort; + // set thread priority + Priority := FComPort.EventThreadPriority; + // select which events are monitored + SetCommMask(FComPort.Handle, EventsToInt(FComPort.Events)); + // execute thread + //{$IFDEF Unicode}Start; {$ELSE} Resume; {$ENDIF} +end; + +// destroy thread +destructor TComThread.Destroy; +begin + Stop; + inherited Destroy; +end; + +// thread action +procedure TComThread.Execute; +var + EventHandles: array[0..1] of THandle; + Overlapped: TOverlapped; + Signaled, BytesTrans, Mask: DWORD; +begin + FillChar(Overlapped, SizeOf(Overlapped), 0); + Overlapped.hEvent := CreateEvent(nil, True, True, nil); + EventHandles[0] := FStopEvent; + EventHandles[1] := Overlapped.hEvent; + repeat + // wait for event to occur on serial port + WaitCommEvent(FComPort.Handle, Mask, @Overlapped); + Signaled := WaitForMultipleObjects(2, @EventHandles, False, INFINITE); + // if event occurs, dispatch it + if (Signaled = WAIT_OBJECT_0 + 1) + and GetOverlappedResult(FComPort.Handle, Overlapped, BytesTrans, False) + then + begin + FEvents := IntToEvents(Mask); + DispatchComMsg; + end; + until Signaled <> (WAIT_OBJECT_0 + 1); + // clear buffers + SetCommMask(FComPort.Handle, 0); + PurgeComm(FComPort.Handle, PURGE_TXCLEAR or PURGE_RXCLEAR); + CloseHandle(Overlapped.hEvent); + CloseHandle(FStopEvent); +end; + +// stop thread +procedure TComThread.Stop; +begin + SetEvent(FStopEvent); + Sleep(0); +end; + +// dispatch events +procedure TComThread.DispatchComMsg; +begin + case FComPort.SyncMethod of + smThreadSync: Synchronize(DoEvents); // call events in main thread + smWindowSync: SendEvents; // call events in thread that opened the port + smNone: DoEvents; // call events inside monitoring thread + end; +end; + +// send events to TCustomComPort component using window message +procedure TComThread.SendEvents; +begin + if evError in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_ERR, 0); + if evRxChar in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXCHAR, 0); + if evTxEmpty in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_TXEMPTY, 0); + if evBreak in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_BREAK, 0); + if evRing in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_RING, 0); + if evCTS in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_CTS, 0); + if evDSR in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_DSR, 0); + if evRxFlag in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_RXFLAG, 0); + if evRing in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_RLSD, 0); + if evRx80Full in FEvents then + SendMessage(FComPort.FWindow, CM_COMPORT, EV_RX80FULL, 0); +end; + +// call events +procedure TComThread.DoEvents; +begin + if evError in FEvents then + FComPort.CallError; + if evRxChar in FEvents then + FComPort.CallRxChar; + if evTxEmpty in FEvents then + FComPort.CallTxEmpty; + if evBreak in FEvents then + FComPort.CallBreak; + if evRing in FEvents then + FComPort.CallRing; + if evCTS in FEvents then + FComPort.CallCTSChange; + if evDSR in FEvents then + FComPort.CallDSRChange; + if evRxFlag in FEvents then + FComPort.CallRxFlag; + if evRLSD in FEvents then + FComPort.CallRLSDChange; + if evRx80Full in FEvents then + FComPort.CallRx80Full; +end; + +(***************************************** + * TComTimeouts class * + *****************************************) + +// create class +constructor TComTimeouts.Create; +begin + inherited Create; + FReadInterval := -1; + FWriteTotalM := 100; + FWriteTotalC := 1000; +end; + +// copy properties to other class +procedure TComTimeouts.AssignTo(Dest: TPersistent); +begin + if Dest is TComTimeouts then + begin + with TComTimeouts(Dest) do + begin + FReadInterval := Self.ReadInterval; + FReadTotalM := Self.ReadTotalMultiplier; + FReadTotalC := Self.ReadTotalConstant; + FWriteTotalM := Self.WriteTotalMultiplier; + FWriteTotalC := Self.WriteTotalConstant; + end + end + else + inherited AssignTo(Dest); +end; + +// select TCustomComPort to own this class +procedure TComTimeouts.SetComPort(const AComPort: TCustomComPort); +begin + FComPort := AComPort; +end; + +// set read interval +procedure TComTimeouts.SetReadInterval(const Value: Integer); +begin + if Value <> FReadInterval then + begin + FReadInterval := Value; + // if possible, apply the changes + if FComPort <> nil then + FComPort.ApplyTimeouts; + end; +end; + +// set read total constant +procedure TComTimeouts.SetReadTotalC(const Value: Integer); +begin + if Value <> FReadTotalC then + begin + FReadTotalC := Value; + if FComPort <> nil then + FComPort.ApplyTimeouts; + end; +end; + +// set read total multiplier +procedure TComTimeouts.SetReadTotalM(const Value: Integer); +begin + if Value <> FReadTotalM then + begin + FReadTotalM := Value; + if FComPort <> nil then + FComPort.ApplyTimeouts; + end; +end; + +// set write total constant +procedure TComTimeouts.SetWriteTotalC(const Value: Integer); +begin + if Value <> FWriteTotalC then + begin + FWriteTotalC := Value; + if FComPort <> nil then + FComPort.ApplyTimeouts; + end; +end; + +// set write total multiplier +procedure TComTimeouts.SetWriteTotalM(const Value: Integer); +begin + if Value <> FWriteTotalM then + begin + FWriteTotalM := Value; + if FComPort <> nil then + FComPort.ApplyTimeouts; + end; +end; + +(***************************************** + * TComFlowControl class * + *****************************************) + +// create class +constructor TComFlowControl.Create; +begin + inherited Create; + FXonChar := #17; + FXoffChar := #19; +end; + +// copy properties to other class +procedure TComFlowControl.AssignTo(Dest: TPersistent); +begin + if Dest is TComFlowControl then + begin + with TComFlowControl(Dest) do + begin + FOutCTSFlow := Self.OutCTSFlow; + FOutDSRFlow := Self.OutDSRFlow; + FControlDTR := Self.ControlDTR; + FControlRTS := Self.ControlRTS; + FXonXoffOut := Self.XonXoffOut; + FXonXoffIn := Self.XonXoffIn; + FTxContinueOnXoff := Self.TxContinueOnXoff; + FDSRSensitivity := Self.DSRSensitivity; + FXonChar := Self.XonChar; + FXoffChar := Self.XoffChar; + end + end + else + inherited AssignTo(Dest); +end; + +// select TCustomComPort to own this class +procedure TComFlowControl.SetComPort(const AComPort: TCustomComPort); +begin + FComPort := AComPort; +end; + +// set input flow control for DTR (data-terminal-ready) +procedure TComFlowControl.SetControlDTR(const Value: TDTRFlowControl); +begin + if Value <> FControlDTR then + begin + FControlDTR := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set input flow control for RTS (request-to-send) +procedure TComFlowControl.SetControlRTS(const Value: TRTSFlowControl); +begin + if Value <> FControlRTS then + begin + FControlRTS := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set ouput flow control for CTS (clear-to-send) +procedure TComFlowControl.SetOutCTSFlow(const Value: Boolean); +begin + if Value <> FOutCTSFlow then + begin + FOutCTSFlow := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set output flow control for DSR (data-set-ready) +procedure TComFlowControl.SetOutDSRFlow(const Value: Boolean); +begin + if Value <> FOutDSRFlow then + begin + FOutDSRFlow := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set software input flow control +procedure TComFlowControl.SetXonXoffIn(const Value: Boolean); +begin + if Value <> FXonXoffIn then + begin + FXonXoffIn := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set software ouput flow control +procedure TComFlowControl.SetXonXoffOut(const Value: Boolean); +begin + if Value <> FXonXoffOut then + begin + FXonXoffOut := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set DSR sensitivity +procedure TComFlowControl.SetDSRSensitivity(const Value: Boolean); +begin + if Value <> FDSRSensitivity then + begin + FDSRSensitivity := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set transfer continue when Xoff is sent +procedure TComFlowControl.SetTxContinueOnXoff(const Value: Boolean); +begin + if Value <> FTxContinueOnXoff then + begin + FTxContinueOnXoff := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set Xon char +procedure TComFlowControl.SetXonChar(const Value: Char); +begin + if Value <> FXonChar then + begin + FXonChar := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set Xoff char +procedure TComFlowControl.SetXoffChar(const Value: Char); +begin + if Value <> FXoffChar then + begin + FXoffChar := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// get common flow control +function TComFlowControl.GetFlowControl: TFlowControl; +begin + if (FControlRTS = rtsHandshake) and (FOutCTSFlow) + and (not FXonXoffIn) and (not FXonXoffOut) + then + Result := fcHardware + else + if (FControlRTS = rtsDisable) and (not FOutCTSFlow) + and (FXonXoffIn) and (FXonXoffOut) + then + Result := fcSoftware + else + if (FControlRTS = rtsDisable) and (not FOutCTSFlow) + and (not FXonXoffIn) and (not FXonXoffOut) + then + Result := fcNone + else + Result := fcCustom; +end; + +// set common flow control +procedure TComFlowControl.SetFlowControl(const Value: TFlowControl); +begin + if Value <> fcCustom then + begin + FControlRTS := rtsDisable; + FOutCTSFlow := False; + FXonXoffIn := False; + FXonXoffOut := False; + case Value of + fcHardware: + begin + FControlRTS := rtsHandshake; + FOutCTSFlow := True; + end; + fcSoftware: + begin + FXonXoffIn := True; + FXonXoffOut := True; + end; + end; + end; + if FComPort <> nil then + FComPort.ApplyDCB; +end; + +(***************************************** + * TComParity class * + *****************************************) + +// create class +constructor TComParity.Create; +begin + inherited Create; + FBits := prNone; +end; + +// copy properties to other class +procedure TComParity.AssignTo(Dest: TPersistent); +begin + if Dest is TComParity then + begin + with TComParity(Dest) do + begin + FBits := Self.Bits; + FCheck := Self.Check; + FReplace := Self.Replace; + FReplaceChar := Self.ReplaceChar; + end + end + else + inherited AssignTo(Dest); +end; + +// select TCustomComPort to own this class +procedure TComParity.SetComPort(const AComPort: TCustomComPort); +begin + FComPort := AComPort; +end; + +// set parity bits +procedure TComParity.SetBits(const Value: TParityBits); +begin + if Value <> FBits then + begin + FBits := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set check parity +procedure TComParity.SetCheck(const Value: Boolean); +begin + if Value <> FCheck then + begin + FCheck := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set replace on parity error +procedure TComParity.SetReplace(const Value: Boolean); +begin + if Value <> FReplace then + begin + FReplace := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +// set replace char +procedure TComParity.SetReplaceChar(const Value: Char); +begin + if Value <> FReplaceChar then + begin + FReplaceChar := Value; + if FComPort <> nil then + FComPort.ApplyDCB; + end; +end; + +(***************************************** + * TComBuffer class * + *****************************************) + +// create class +constructor TComBuffer.Create; +begin + inherited Create; + FInputSize := 1024; + FOutputSize := 1024; +end; + +// copy properties to other class +procedure TComBuffer.AssignTo(Dest: TPersistent); +begin + if Dest is TComBuffer then + begin + with TComBuffer(Dest) do + begin + FOutputSize := Self.OutputSize; + FInputSize := Self.InputSize; + end + end + else + inherited AssignTo(Dest); +end; + +// select TCustomComPort to own this class +procedure TComBuffer.SetComPort(const AComPort: TCustomComPort); +begin + FComPort := AComPort; +end; + +// set input size +procedure TComBuffer.SetInputSize(const Value: Integer); +begin + if Value <> FInputSize then + begin + FInputSize := Value; + if (FInputSize mod 2) = 1 then + Dec(FInputSize); + if FComPort <> nil then + FComPort.ApplyBuffer; + end; +end; + +// set ouput size +procedure TComBuffer.SetOutputSize(const Value: Integer); +begin + if Value <> FOutputSize then + begin + FOutputSize := Value; + if (FOutputSize mod 2) = 1 then + Dec(FOutputSize); + if FComPort <> nil then + FComPort.ApplyBuffer; + end; +end; + +(***************************************** + * TCustomComPort component * + *****************************************) + +// create component +constructor TCustomComPort.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + // component cannot reside on inheritable forms + FComponentStyle := FComponentStyle - [csInheritable]; + FLinks := TList.Create; + FTriggersOnRxChar := True; + FEventThreadPriority := tpNormal; + FBaudRate := br9600; + FCustomBaudRate := 9600; + FPort := 'COM1'; + FStopBits := sbOneStopBit; + FDataBits := dbEight; + FEvents := [evRxChar, evTxEmpty, evRxFlag, evRing, evBreak, + evCTS, evDSR, evError, evRLSD, evRx80Full]; + FHandle := INVALID_HANDLE_VALUE; + FStoredProps := [spBasic]; + FParity := TComParity.Create; + FParity.SetComPort(Self); + FFlowControl := TComFlowControl.Create; + FFlowControl.SetComPort(Self); + FTimeouts := TComTimeouts.Create; + FTimeouts.SetComPort(Self); + FBuffer := TComBuffer.Create; + FBuffer.SetComPort(Self); + FCodePage := CP_ACP;//0; // uses default system codepage +end; + +// destroy component +destructor TCustomComPort.Destroy; +begin + Close; + FBuffer.Free; + FFlowControl.Free; + FTimeouts.Free; + FParity.Free; + inherited Destroy; + FLinks.Free; +end; + +//Handle Exceptions +procedure TCustomComPort.CallException(AnException:Word; const WinError:Int64 =0); +var winmessage:string; +begin + if Assigned(FOnException) then + begin + if WinError > 0 then //get windows error string + try Win32Check(winerror = 0); except on E:Exception do WinMessage:=e.message; end; + FOnException(self,TComExceptions(AnException),ComErrorMessages[AnException],WinError, WinMessage); + end + else + if WinError > 0 then raise EComPort.Create(AnException, WinError) + else raise EComPort.CreateNoWinCode(AnException); + +end; +// create handle to serial port +procedure TCustomComPort.CreateHandle; +begin + FHandle := CreateFile( + PChar('\\.\' + FPort), + GENERIC_READ or GENERIC_WRITE, + 0, + nil, + OPEN_EXISTING, + FILE_FLAG_OVERLAPPED, + 0); + + if FHandle = INVALID_HANDLE_VALUE then + //raise EComPort.Create + CallException(CError_OpenFailed, GetLastError); +end; + +// destroy serial port handle +procedure TCustomComPort.DestroyHandle; +begin + if FHandle <> INVALID_HANDLE_VALUE then + begin + if CloseHandle(FHandle) then + FHandle := INVALID_HANDLE_VALUE; + end; +end; + +procedure TCustomComPort.Loaded; +begin + inherited Loaded; + // open port if Connected is True at design-time + if FConnected and not (csDesigning in ComponentState) then + begin + FConnected := False; + try + Open; + except + Application.HandleException(Self); + end; + end; +end; + +// call events which have been dispatch using window message +procedure TCustomComPort.WindowMethod(var Message: TMessage); +begin + with Message do + if Msg = CM_COMPORT then + try + if InSendMessage then + ReplyMessage(0); + if FConnected then + case wParam of + EV_RXCHAR: CallRxChar; + EV_TXEMPTY: CallTxEmpty; + EV_BREAK: CallBreak; + EV_RING: CallRing; + EV_CTS: CallCTSChange; + EV_DSR: CallDSRChange; + EV_RXFLAG: CallRxFlag; + EV_RLSD: CallRLSDChange; + EV_ERR: CallError; + EV_RX80FULL: CallRx80Full; + end + except + Application.HandleException(Self); + end + else + Result := DefWindowProc(FWindow, Msg, wParam, lParam); +end; + +// prevent from applying changes at runtime +procedure TCustomComPort.BeginUpdate; +begin + FUpdateCount := FUpdateCount + 1; +end; + +// apply the changes made since BeginUpdate call +procedure TCustomComPort.EndUpdate; +begin + if FUpdateCount > 0 then + begin + FUpdateCount := FUpdateCount - 1; + if FUpdateCount = 0 then + SetupComPort; + end; +end; + +// open port +procedure TCustomComPort.Open; +begin + // if already connected, do nothing + if not FConnected and not (csDesigning in ComponentState) then + begin + CallBeforeOpen; + // open port + CreateHandle; + FConnected := True; + try + // initialize port + SetupComPort; + except + // error occured during initialization, destroy handle + DestroyHandle; + FConnected := False; + raise; + end; + // if at least one event is set, create special thread to monitor port + if (FEvents = []) then + FThreadCreated := False + else + begin + if (FSyncMethod = smWindowSync) then +{$IFDEF DELPHI_6_OR_HIGHER} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + FWindow := AllocateHWnd(WindowMethod); +{$IFDEF DELPHI_6_OR_HIGHER} + {$WARN SYMBOL_DEPRECATED ON} +{$ENDIF} + FEventThread := TComThread.Create(Self); + FThreadCreated := True; + end; + // port is succesfully opened, do any additional initialization + CallAfterOpen; + end; +end; + +// close port +procedure TCustomComPort.Close; +begin + // if already closed, do nothing + if FConnected and not (csDesigning in ComponentState) then + begin + CallBeforeClose; + // abort all pending operations + AbortAllAsync; + // stop monitoring for events + if FThreadCreated then + begin + FEventThread.Free; + FThreadCreated := False; + if FSyncMethod = smWindowSync then +{$IFDEF DELPHI_6_OR_HIGHER} + {$WARN SYMBOL_DEPRECATED OFF} +{$ENDIF} + DeallocateHWnd(FWindow); +{$IFDEF DELPHI_6_OR_HIGHER} + {$WARN SYMBOL_DEPRECATED ON} +{$ENDIF} + end; + // close port + DestroyHandle; + FConnected := False; + // port is closed, do any additional finalization + CallAfterClose; + end; +end; + +// apply port properties +procedure TCustomComPort.ApplyDCB; +const + CParityBits: array[TParityBits] of Integer = + (NOPARITY, ODDPARITY, EVENPARITY, MARKPARITY, SPACEPARITY); + CStopBits: array[TStopBits] of Integer = + (ONESTOPBIT, ONE5STOPBITS, TWOSTOPBITS); + CBaudRate: array[TBaudRate] of Integer = + (0, CBR_110, CBR_300, CBR_600, CBR_1200, CBR_2400, CBR_4800, CBR_9600, + CBR_14400, CBR_19200, CBR_38400, CBR_56000, CBR_57600, CBR_115200, + CBR_128000, CBR_256000); + CDataBits: array[TDataBits] of Integer = (5, 6, 7, 8); + CControlRTS: array[TRTSFlowControl] of Integer = + (RTS_CONTROL_DISABLE shl 12, + RTS_CONTROL_ENABLE shl 12, + RTS_CONTROL_HANDSHAKE shl 12, + RTS_CONTROL_TOGGLE shl 12); + CControlDTR: array[TDTRFlowControl] of Integer = + (DTR_CONTROL_DISABLE shl 4, + DTR_CONTROL_ENABLE shl 4, + DTR_CONTROL_HANDSHAKE shl 4); + +var + DCB: TDCB; + +begin + // if not connected or inside BeginUpdate/EndUpdate block, do nothing + if FConnected and (FUpdateCount = 0) and + not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then + begin + DCB.DCBlength := SizeOf(TDCB); + DCB.XonLim := FBuffer.InputSize div 4; + DCB.XoffLim := DCB.XonLim; + DCB.EvtChar := AnsiChar(FEventChar); + + DCB.Flags := dcb_Binary; + if FDiscardNull then + DCB.Flags := DCB.Flags or dcb_Null; + + with FFlowControl do + begin + DCB.XonChar := AnsiChar(XonChar); + DCB.XoffChar := AnsiChar(XoffChar); + if OutCTSFlow then + DCB.Flags := DCB.Flags or dcb_OutxCTSFlow; + if OutDSRFlow then + DCB.Flags := DCB.Flags or dcb_OutxDSRFlow; + DCB.Flags := DCB.Flags or CControlDTR[ControlDTR] + or CControlRTS[ControlRTS]; + if XonXoffOut then + DCB.Flags := DCB.Flags or dcb_OutX; + if XonXoffIn then + DCB.Flags := DCB.Flags or dcb_InX; + if DSRSensitivity then + DCB.Flags := DCB.Flags or dcb_DSRSensivity; + if TxContinueOnXoff then + DCB.Flags := DCB.Flags or dcb_TxContinueOnXoff; + end; + + DCB.Parity := CParityBits[FParity.Bits]; + DCB.StopBits := CStopBits[FStopBits]; + if FBaudRate <> brCustom then + DCB.BaudRate := CBaudRate[FBaudRate] + else + DCB.BaudRate := FCustomBaudRate; + DCB.ByteSize := CDataBits[FDataBits]; + + if FParity.Check then + begin + DCB.Flags := DCB.Flags or dcb_Parity; + if FParity.Replace then + begin + DCB.Flags := DCB.Flags or dcb_ErrorChar; + DCB.ErrorChar := AnsiChar(FParity.ReplaceChar); + end; + end; + + // apply settings + if not SetCommState(FHandle, DCB) then + //raise EComPort.Create + CallException(CError_SetStateFailed, GetLastError); + end; +end; + +// apply timeout properties +procedure TCustomComPort.ApplyTimeouts; +var + Timeouts: TCommTimeouts; + + function GetTOValue(const Value: Integer): DWORD; + begin + if Value = -1 then + Result := MAXDWORD + else + Result := Value; + end; + +begin + // if not connected or inside BeginUpdate/EndUpdate block, do nothing + if FConnected and (FUpdateCount = 0) and + not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then + begin + Timeouts.ReadIntervalTimeout := GetTOValue(FTimeouts.ReadInterval); + Timeouts.ReadTotalTimeoutMultiplier := GetTOValue(FTimeouts.ReadTotalMultiplier); + Timeouts.ReadTotalTimeoutConstant := GetTOValue(FTimeouts.ReadTotalConstant); + Timeouts.WriteTotalTimeoutMultiplier := GetTOValue(FTimeouts.WriteTotalMultiplier); + Timeouts.WriteTotalTimeoutConstant := GetTOValue(FTimeouts.WriteTotalConstant); + + // apply settings + if not SetCommTimeouts(FHandle, Timeouts) then + //raise EComPort.Create + CallException(CError_TimeoutsFailed, GetLastError); + end; +end; + +// apply buffers +procedure TCustomComPort.ApplyBuffer; +begin + // if not connected or inside BeginUpdate/EndUpdate block, do nothing + if FConnected and (FUpdateCount = 0) and + not ((csDesigning in ComponentState) or (csLoading in ComponentState)) + then + //apply settings + if not SetupComm(FHandle, FBuffer.InputSize, FBuffer.OutputSize) then + //raise EComPort.Create + CallException(CError_SetupComFailed, GetLastError); +end; + +// initialize port +procedure TCustomComPort.SetupComPort; +begin + ApplyBuffer; + ApplyDCB; + ApplyTimeouts; +end; + +// get number of bytes in input buffer +function TCustomComPort.InputCount: Integer; +var + Errors: DWORD; + ComStat: TComStat; +begin + if not ClearCommError(FHandle, Errors, @ComStat) then + //raise EComPort.Create + CallException(CError_ClearComFailed, GetLastError); + Result := ComStat.cbInQue; +end; + +// get number of bytes in output buffer +function TCustomComPort.OutputCount: Integer; +var + Errors: DWORD; + ComStat: TComStat; +begin + if not ClearCommError(FHandle, Errors, @ComStat) then + //raise EComPort.Create + CallException(CError_ClearComFailed, GetLastError); + Result := ComStat.cbOutQue; +end; + +// get signals which are in high state +function TCustomComPort.Signals: TComSignals; +var + Status: DWORD; +begin + if not GetCommModemStatus(FHandle, Status) then + //raise EComPort.Create + CallException(CError_ModemStatFailed, GetLastError); + Result := []; + + if (MS_CTS_ON and Status) <> 0 then + Result := Result + [csCTS]; + if (MS_DSR_ON and Status) <> 0 then + Result := Result + [csDSR]; + if (MS_RING_ON and Status) <> 0 then + Result := Result + [csRing]; + if (MS_RLSD_ON and Status) <> 0 then + Result := Result + [csRLSD]; +end; + +// get port state flags +function TCustomComPort.StateFlags: TComStateFlags; +var + Errors: DWORD; + ComStat: TComStat; +begin + if not ClearCommError(FHandle, Errors, @ComStat) then + //raise EComPort.Create + CallException(CError_ClearComFailed, GetLastError); + Result := ComStat.Flags; +end; + +// set hardware line break +procedure TCustomComPort.SetBreak(OnOff: Boolean); +var + Act: Integer; +begin + if OnOff then + Act := Windows.SETBREAK + else + Act := Windows.CLRBREAK; + + if not EscapeCommFunction(FHandle, Act) then + //raise EComPort.Create + CallException(CError_EscapeComFailed, GetLastError); +end; + +// set DTR signal +procedure TCustomComPort.SetDTR(OnOff: Boolean); +var + Act: DWORD; +begin + if OnOff then + Act := Windows.SETDTR + else + Act := Windows.CLRDTR; + + if not EscapeCommFunction(FHandle, Act) then + //raise EComPort.Create + CallException(CError_EscapeComFailed, GetLastError); +end; + +// set RTS signals +procedure TCustomComPort.SetRTS(OnOff: Boolean); +var + Act: DWORD; +begin + if OnOff then + Act := Windows.SETRTS + else + Act := Windows.CLRRTS; + + if not EscapeCommFunction(FHandle, Act) then + //raise EComPort.Create + CallException(CError_EscapeComFailed, GetLastError); +end; + +// set XonXoff state +procedure TCustomComPort.SetXonXoff(OnOff: Boolean); +var + Act: DWORD; +begin + if OnOff then + Act := Windows.SETXON + else + Act := Windows.SETXOFF; + + if not EscapeCommFunction(FHandle, Act) then + //raise EComPort.Create + CallException(CError_EscapeComFailed, GetLastError); +end; + +// clear input and/or output buffer +procedure TCustomComPort.ClearBuffer(Input, Output: Boolean); +var + Flag: DWORD; +begin + Flag := 0; + if Input then + Flag := PURGE_RXCLEAR; + if Output then + Flag := Flag or PURGE_TXCLEAR; + + if not PurgeComm(FHandle, Flag) then + //raise EComPort.Create + CallException(CError_PurgeFailed, GetLastError); +end; + +// return last errors on port +function TCustomComPort.LastErrors: TComErrors; +var + Errors: DWORD; + ComStat: TComStat; +begin + if not ClearCommError(FHandle, Errors, @ComStat) then + //raise EComPort.Create + CallException(CError_ClearComFailed, GetLastError); + Result := []; + + if (CE_FRAME and Errors) <> 0 then + Result := Result + [ceFrame]; + if ((CE_RXPARITY and Errors) <> 0) and FParity.Check then // get around a bug + Result := Result + [ceRxParity]; + if (CE_OVERRUN and Errors) <> 0 then + Result := Result + [ceOverrun]; + if (CE_RXOVER and Errors) <> 0 then + Result := Result + [ceRxOver]; + if (CE_TXFULL and Errors) <> 0 then + Result := Result + [ceTxFull]; + if (CE_BREAK and Errors) <> 0 then + Result := Result + [ceBreak]; + if (CE_IOE and Errors) <> 0 then + Result := Result + [ceIO]; + if (CE_MODE and Errors) <> 0 then + Result := Result + [ceMode]; +end; + +// prepare PAsync variable for read/write operation +procedure PrepareAsync(AKind: TOperationKind; const Buffer; Count: Integer; AsyncPtr: PAsync); +begin + with AsyncPtr^ do + begin + Kind := AKind; + if Data <> nil then + FreeMem(Data); + GetMem(Data, Count); + Move(Buffer, Data^, Count); + Size := Count; + end; +end; + +// perform asynchronous write operation +function TCustomComPort.WriteAsync(const Buffer; Count: Integer; var AsyncPtr: PAsync): Integer; +var + Success: Boolean; + BytesTrans: DWORD; +begin + if AsyncPtr = nil then + //raise EComPort.CreateNoWinCode + CallException(CError_InvalidAsync); + if FHandle = INVALID_HANDLE_VALUE then + //raise EComPort.Create + CallException(CError_PortNotOpen, -24); + PrepareAsync(okWrite, Buffer, Count, AsyncPtr); + + Success := WriteFile(FHandle, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped) + or (GetLastError = ERROR_IO_PENDING); + + if not Success then + //raise EComPort.Create + CallException(CError_WriteFailed, GetLastError); + + SendSignalToLink(leTx, True); + Result := BytesTrans; +end; + +// perform synchronous write operation +function TCustomComPort.Write(const Buffer; Count: Integer): Integer; +var + AsyncPtr: PAsync; +begin + InitAsync(AsyncPtr); + try + WriteAsync(Buffer, Count, AsyncPtr); + Result := WaitForAsync(AsyncPtr); + finally + DoneAsync(AsyncPtr); + end; +end; + +// perform asynchronous write operation +function TCustomComPort.WriteStrAsync(var Str: string; var AsyncPtr: PAsync): Integer; +var sa : Ansistring; var i:integer; +begin + if Length(Str) > 0 then + begin + setlength(sa,length(str)); + {$IFDEF Unicode} + if length(sa)>0 then + begin + for i := 1 to length(str) do sa[i] := ansichar(byte(str[i])); + move(sa[1],str[1],length(sa)); + end; + {$ENDIF} + Result := WriteAsync(Str[1], Length(Str), AsyncPtr) + end + else + Result := 0; +end; +// perform synchronous write operation +function TCustomComPort.WriteStr(Str: string): Integer; +var + AsyncPtr: PAsync; +begin + InitAsync(AsyncPtr); + try + WriteStrAsync(Str, AsyncPtr); + Result := WaitForAsync(AsyncPtr); + finally + DoneAsync(AsyncPtr); + end; +end; +//Pierre Yager - includes codepage converstion of strings being sent +function TCustomComPort.WriteUnicodeString(const Str: Unicodestring): Integer; +var + l: Integer; + rb: AnsiString; +begin + l := WideCharToMultiByte(FCodePage, 0, PWideChar(Str), Length(Str), nil, 0, nil, nil); + SetLength(rb, l); + WideCharToMultiByte(FCodePage, 0, PWideChar(Str), Length(Str), PAnsiChar(rb), l, nil, nil); + Result := WriteStr(string(rb)); +end; + +//Pierre Yager - includes codepage converstion of strings received +function TCustomComPort.ReadUnicodeString(var Str: UnicodeString; Count: Integer): Integer; +var + rb: AnsiString; + l: Integer; + AsyncPtr: PAsync; +begin + InitAsync(AsyncPtr); + try + setLength(rb,count); + Result := ReadAsync(rb[1], Count, AsyncPtr); // ReadStr(s, Count); + //{$IFDEF Unicode}rb := UTF8Encode(s);{$ELSE} rb := s; {$ENDIF} + l := MultiByteToWideChar(FCodePage, 0, PAnsiChar(rb), Length(rb), nil, 0); + SetLength(Str, l); + Result := MultiByteToWideChar(FCodePage, 0, PAnsiChar(rb), Length(rb), PWideChar(Str), l); + finally + DoneAsync(AsyncPtr); + end; +end; + +// perform asynchronous read operation +function TCustomComPort.ReadAsync(var Buffer; Count: Integer; var AsyncPtr: PAsync): Integer; +var + Success: Boolean; + BytesTrans: DWORD; +begin + if AsyncPtr = nil then + //raise EComPort.CreateNoWinCode + CallException(CError_InvalidAsync); + AsyncPtr^.Kind := okRead; + if FHandle = INVALID_HANDLE_VALUE then + //raise EComPort.Create + CallException(CError_PortNotOpen, -24); + + Success := ReadFile(FHandle, Buffer, Count, BytesTrans, @AsyncPtr^.Overlapped) + or (GetLastError = ERROR_IO_PENDING); + + if not Success then + //raise EComPort.Create + CallException(CError_ReadFailed, GetLastError); + + Result := BytesTrans; +end; + +// perform synchronous read operation +function TCustomComPort.Read(var Buffer; Count: Integer): Integer; +var + AsyncPtr: PAsync; +begin + InitAsync(AsyncPtr); + try + ReadAsync(Buffer, Count, AsyncPtr); + Result := WaitForAsync(AsyncPtr); + finally + DoneAsync(AsyncPtr); + end; +end; + +// perform asynchronous read operation +function TCustomComPort.ReadStrAsync(var Str: Ansistring; Count: Integer; var AsyncPtr: PAsync): Integer; +begin + setlength(str,count); + if Count > 0 then + Result := ReadAsync(str[1], Count, AsyncPtr) + else + Result := 0; +end; + +// perform synchronous read operation +function TCustomComPort.ReadStr(var Str: string; Count: Integer): Integer; +var + AsyncPtr: PAsync; + sa :ansistring; + i : integer; +begin + InitAsync(AsyncPtr); + try + ReadStrAsync(sa, Count, AsyncPtr); + Result := WaitForAsync(AsyncPtr); + SetLength(sa, Result); + SetLength(str, Result); + {$IFDEF Unicode} + if length(sa)>0 then + for i := 1 to length(sa) do str[i] := char(byte(sa[i])) + {$ELSE} + str := sa; + {$ENDIF} + finally + DoneAsync(AsyncPtr); + end; +end; + +function ErrorCode(AsyncPtr: PAsync): Integer; +begin + Result := 0; + case AsyncPtr^.Kind of + okWrite: Result := CError_WriteFailed; + okRead: Result := CError_ReadFailed; + end; +end; + +// wait for asynchronous operation to end +function TCustomComPort.WaitForAsync(var AsyncPtr: PAsync): Integer; +var + BytesTrans, Signaled: DWORD; + Success: Boolean; +begin + if AsyncPtr = nil then + //raise EComPort.CreateNoWinCode + CallException(CError_InvalidAsync); + + Signaled := WaitForSingleObject(AsyncPtr^.Overlapped.hEvent, INFINITE); + Success := (Signaled = WAIT_OBJECT_0) and + (GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False)); + + if not Success then + //raise EComPort.Create + CallException(ErrorCode(AsyncPtr), GetLastError); + + if (AsyncPtr^.Kind = okRead) and (InputCount = 0) then + SendSignalToLink(leRx, False) + else + if AsyncPtr^.Data <> nil then + TxNotifyLink(AsyncPtr^.Data^, AsyncPtr^.Size); + + Result := BytesTrans; +end; + +// abort all asynchronous operations +procedure TCustomComPort.AbortAllAsync; +begin + if not PurgeComm(FHandle, PURGE_TXABORT or PURGE_RXABORT) then + //raise EComPort.Create + CallException(CError_PurgeFailed, GetLastError); +end; + +// detect whether asynchronous operation is completed +function TCustomComPort.IsAsyncCompleted(AsyncPtr: PAsync): Boolean; +var + BytesTrans: DWORD; +begin + if AsyncPtr = nil then + //raise EComPort.CreateNoWinCode + CallException(CError_InvalidAsync); + + Result := GetOverlappedResult(FHandle, AsyncPtr^.Overlapped, BytesTrans, False); + if not Result then + if (GetLastError <> ERROR_IO_PENDING) and (GetLastError <> ERROR_IO_INCOMPLETE) then + //raise EComPort.Create + CallException(CError_AsyncCheck, GetLastError); +end; + +// waits for event to occur on serial port +procedure TCustomComPort.WaitForEvent(var Events: TComEvents; + StopEvent: THandle; Timeout: Integer); +var + Overlapped: TOverlapped; + Mask: DWORD; + Success: Boolean; + Signaled, EventHandleCount: Integer; + EventHandles: array[0..1] of THandle; +begin + // cannot call method if event thread is running + if FThreadCreated then + //raise EComPort.CreateNoWinCode + CallException(CError_ThreadCreated); + + FillChar(Overlapped, SizeOf(TOverlapped), 0); + Overlapped.hEvent := CreateEvent(nil, True, False, nil); + EventHandles[0] := Overlapped.hEvent; + if StopEvent <> 0 then + begin + EventHandles[1] := StopEvent; + EventHandleCount := 2; + end + else + EventHandleCount := 1; + + try + SetCommMask(FHandle, EventsToInt(Events)); + // let's wait for event or timeout + Success := WaitCommEvent(FHandle, Mask, @Overlapped); + + if (Success) or (GetLastError = ERROR_IO_PENDING) then + begin + Signaled := WaitForMultipleObjects(EventHandleCount, @EventHandles, + False, Timeout); + Success := (Signaled = WAIT_OBJECT_0) + or (Signaled = WAIT_OBJECT_0 + 1) or (Signaled = WAIT_TIMEOUT); + SetCommMask(FHandle, 0); + end; + + if not Success then + //raise EComPort.Create + CallException(CError_WaitFailed, GetLastError); + + Events := IntToEvents(Mask); + finally + CloseHandle(Overlapped.hEvent); + end; +end; + +// transmit char ahead of any pending data in ouput buffer +procedure TCustomComPort.TransmitChar(Ch: Char); +begin + if not TransmitCommChar(FHandle, AnsiChar(Ch)) then + //raise EComPort.Create + CallException(CError_TransmitFailed, GetLastError); +end; + +// show port setup dialog +{$IFNDEF No_Dialogs} +procedure TCustomComPort.ShowSetupDialog; +begin + EditComPort(Self); +end; +{$ENDIF} + +// some conversion routines +function BoolToStr(const Value: Boolean): string; +begin + if Value then + Result := 'Yes' + else + Result := 'No'; +end; + +function StrToBool(const Value: string): Boolean; +begin + if UpperCase(Value) = 'YES' then + Result := True + else + Result := False; +end; + +function DTRToStr(DTRFlowControl: TDTRFlowControl): string; +const + DTRStrings: array[TDTRFlowControl] of string = ('Disable', 'Enable', + 'Handshake'); +begin + Result := DTRStrings[DTRFlowControl]; +end; + +function RTSToStr(RTSFlowControl: TRTSFlowControl): string; +const + RTSStrings: array[TRTSFlowControl] of string = ('Disable', 'Enable', + 'Handshake', 'Toggle'); +begin + Result := RTSStrings[RTSFlowControl]; +end; + +function StrToRTS(Str: string): TRTSFlowControl; +var + I: TRTSFlowControl; +begin + I := Low(TRTSFlowControl); + while (I <= High(TRTSFlowControl)) do + begin + if UpperCase(Str) = UpperCase(RTSToStr(I)) then + Break; + I := Succ(I); + end; + if I > High(TRTSFlowControl) then + Result := rtsDisable + else + Result := I; +end; + +function StrToDTR(Str: string): TDTRFlowControl; +var + I: TDTRFlowControl; +begin + I := Low(TDTRFlowControl); + while (I <= High(TDTRFlowControl)) do + begin + if UpperCase(Str) = UpperCase(DTRToStr(I)) then + Break; + I := Succ(I); + end; + if I > High(TDTRFlowControl) then + Result := dtrDisable + else + Result := I; +end; + +function StrToChar(Str: string): Char; +var + A: Integer; +begin + if Length(Str) > 0 then + begin + if (Str[1] = '#') and (Length(Str) > 1) then + begin + try + A := StrToInt(Copy(Str, 2, Length(Str) - 1)); + except + A := 0; + end; + Result := Chr(Byte(A)); + end + else + Result := Str[1]; + end + else + Result := #0; +end; + +function CharToStr(Ch: Char): string; +begin + {$IFDEF Unicode} + if CharInSet(ch,[#33..#127]) then + {$ELSE} + if Ch in [#33..#127] then {$ENDIF} + Result := Ch + else + Result := '#' + IntToStr(Ord(Ch)); +end; + +// store settings to ini file +procedure TCustomComPort.StoreIniFile(IniFile: TIniFile); +begin + if spBasic in FStoredProps then + begin + IniFile.WriteString(Name, 'Port', Port); + IniFile.WriteString(Name, 'BaudRate', BaudRateToStr(BaudRate)); + if BaudRate = brCustom then + IniFile.WriteInteger(Name, 'CustomBaudRate', CustomBaudRate); + IniFile.WriteString(Name, 'StopBits', StopBitsToStr(StopBits)); + IniFile.WriteString(Name, 'DataBits', DataBitsToStr(DataBits)); + IniFile.WriteString(Name, 'Parity', ParityToStr(Parity.Bits)); + IniFile.WriteString(Name, 'FlowControl', FlowControlToStr(FlowControl.FlowControl)); + end; + if spOthers in FStoredProps then + begin + IniFile.WriteString(Name, 'EventChar', CharToStr(EventChar)); + IniFile.WriteString(Name, 'DiscardNull', BoolToStr(DiscardNull)); + end; + if spParity in FStoredProps then + begin + IniFile.WriteString(Name, 'Parity.Check', BoolToStr(Parity.Check)); + IniFile.WriteString(Name, 'Parity.Replace', BoolToStr(Parity.Replace)); + IniFile.WriteString(Name, 'Parity.ReplaceChar', CharToStr(Parity.ReplaceChar)); + end; + if spBuffer in FStoredProps then + begin + IniFile.WriteInteger(Name, 'Buffer.OutputSize', Buffer.OutputSize); + IniFile.WriteInteger(Name, 'Buffer.InputSize', Buffer.InputSize); + end; + if spTimeouts in FStoredProps then + begin + IniFile.WriteInteger(Name, 'Timeouts.ReadInterval', Timeouts.ReadInterval); + IniFile.WriteInteger(Name, 'Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant); + IniFile.WriteInteger(Name, 'Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier); + IniFile.WriteInteger(Name, 'Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant); + IniFile.WriteInteger(Name, 'Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier); + end; + if spFlowControl in FStoredProps then + begin + IniFile.WriteString(Name, 'FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS)); + IniFile.WriteString(Name, 'FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR)); + IniFile.WriteString(Name, 'FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity)); + IniFile.WriteString(Name, 'FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow)); + IniFile.WriteString(Name, 'FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutDSRFlow)); + IniFile.WriteString(Name, 'FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff)); + IniFile.WriteString(Name, 'FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn)); + IniFile.WriteString(Name, 'FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut)); + IniFile.WriteString(Name, 'FlowControl.XoffChar', CharToStr(FlowControl.XoffChar)); + IniFile.WriteString(Name, 'FlowControl.XonChar', CharToStr(FlowControl.XonChar)); + end; +end; + +// store settings to registry +procedure TCustomComPort.StoreRegistry(Reg: TRegistry); +begin + if spBasic in FStoredProps then + begin + Reg.WriteString('Port', Port); + Reg.WriteString('BaudRate', BaudRateToStr(BaudRate)); + if BaudRate = brCustom then + Reg.WriteInteger('CustomBaudRate', CustomBaudRate); + Reg.WriteString('StopBits', StopBitsToStr(StopBits)); + Reg.WriteString('DataBits', DataBitsToStr(DataBits)); + Reg.WriteString('Parity', ParityToStr(Parity.Bits)); + Reg.WriteString('FlowControl', FlowControlToStr(FlowControl.FlowControl)); + end; + if spOthers in FStoredProps then + begin + Reg.WriteString('EventChar', CharToStr(EventChar)); + Reg.WriteString('DiscardNull', BoolToStr(DiscardNull)); + end; + if spParity in FStoredProps then + begin + Reg.WriteString('Parity.Check', BoolToStr(Parity.Check)); + Reg.WriteString('Parity.Replace', BoolToStr(Parity.Replace)); + Reg.WriteString('Parity.ReplaceChar', CharToStr(Parity.ReplaceChar)); + end; + if spBuffer in FStoredProps then + begin + Reg.WriteInteger('Buffer.OutputSize', Buffer.OutputSize); + Reg.WriteInteger('Buffer.InputSize', Buffer.InputSize); + end; + if spTimeouts in FStoredProps then + begin + Reg.WriteInteger('Timeouts.ReadInterval', Timeouts.ReadInterval); + Reg.WriteInteger('Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant); + Reg.WriteInteger('Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier); + Reg.WriteInteger('Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant); + Reg.WriteInteger('Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier); + end; + if spFlowControl in FStoredProps then + begin + Reg.WriteString('FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS)); + Reg.WriteString('FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR)); + Reg.WriteString('FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity)); + Reg.WriteString('FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow)); + Reg.WriteString('FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutDSRFlow)); + Reg.WriteString('FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff)); + Reg.WriteString('FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn)); + Reg.WriteString('FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut)); + Reg.WriteString('FlowControl.XoffChar', CharToStr(FlowControl.XoffChar)); + Reg.WriteString('FlowControl.XonChar', CharToStr(FlowControl.XonChar)); + end; +end; + +// load settings from ini file +procedure TCustomComPort.LoadIniFile(IniFile: TIniFile); +begin + if spBasic in FStoredProps then + begin + Port := IniFile.ReadString(Name, 'Port', Port); + BaudRate := StrToBaudRate(IniFile.ReadString(Name, 'BaudRate', BaudRateToStr(BaudRate))); + if BaudRate = brCustom then + CustomBaudRate := IniFile.ReadInteger(Name, 'CustomBaudRate', 9600); + StopBits := StrToStopBits(IniFile.ReadString(Name, 'StopBits', StopBitsToStr(StopBits))); + DataBits := StrToDataBits(IniFile.ReadString(Name, 'DataBits', DataBitsToStr(DataBits))); + Parity.Bits := StrToParity(IniFile.ReadString(Name, 'Parity', ParityToStr(Parity.Bits))); + FlowControl.FlowControl := StrToFlowControl( + IniFile.ReadString(Name, 'FlowControl', FlowControlToStr(FlowControl.FlowControl))); + end; + if spOthers in FStoredProps then + begin + EventChar := StrToChar(IniFile.ReadString(Name, 'EventChar', CharToStr(EventChar))); + DiscardNull := StrToBool(IniFile.ReadString(Name, 'DiscardNull', BoolToStr(DiscardNull))); + end; + if spParity in FStoredProps then + begin + Parity.Check := StrToBool(IniFile.ReadString(Name, 'Parity.Check', BoolToStr(Parity.Check))); + Parity.Replace := StrToBool(IniFile.ReadString(Name, 'Parity.Replace', BoolToStr(Parity.Replace))); + Parity.ReplaceChar := StrToChar(IniFile.ReadString(Name, 'Parity.ReplaceChar', CharToStr(Parity.ReplaceChar))); + end; + if spBuffer in FStoredProps then + begin + Buffer.OutputSize := IniFile.ReadInteger(Name, 'Buffer.OutputSize', Buffer.OutputSize); + Buffer.InputSize := IniFile.ReadInteger(Name, 'Buffer.InputSize', Buffer.InputSize); + end; + if spTimeouts in FStoredProps then + begin + Timeouts.ReadInterval := IniFile.ReadInteger(Name, 'Timeouts.ReadInterval', Timeouts.ReadInterval); + Timeouts.ReadTotalConstant := IniFile.ReadInteger(Name, 'Timeouts.ReadTotalConstant', Timeouts.ReadTotalConstant); + Timeouts.ReadTotalMultiplier := IniFile.ReadInteger(Name, 'Timeouts.ReadTotalMultiplier', Timeouts.ReadTotalMultiplier); + Timeouts.WriteTotalConstant := IniFile.ReadInteger(Name, 'Timeouts.WriteTotalConstant', Timeouts.WriteTotalConstant); + Timeouts.WriteTotalMultiplier := IniFile.ReadInteger(Name, 'Timeouts.WriteTotalMultiplier', Timeouts.WriteTotalMultiplier); + end; + if spFlowControl in FStoredProps then + begin + FlowControl.ControlRTS := StrToRTS(IniFile.ReadString(Name, 'FlowControl.ControlRTS', RTSToStr(FlowControl.ControlRTS))); + FlowControl.ControlDTR := StrToDTR(IniFile.ReadString(Name, 'FlowControl.ControlDTR', DTRToStr(FlowControl.ControlDTR))); + FlowControl.DSRSensitivity := StrToBool(IniFile.ReadString(Name, 'FlowControl.DSRSensitivity', BoolToStr(FlowControl.DSRSensitivity))); + FlowControl.OutCTSFlow := StrToBool(IniFile.ReadString(Name, 'FlowControl.OutCTSFlow', BoolToStr(FlowControl.OutCTSFlow))); + FlowControl.OutDSRFlow := StrToBool(IniFile.ReadString(Name, 'FlowControl.OutDSRFlow', BoolToStr(FlowControl.OutCTSFlow))); + FlowControl.TxContinueOnXoff := StrToBool(IniFile.ReadString(Name, 'FlowControl.TxContinueOnXoff', BoolToStr(FlowControl.TxContinueOnXoff))); + FlowControl.XonXoffIn := StrToBool(IniFile.ReadString(Name, 'FlowControl.XonXoffIn', BoolToStr(FlowControl.XonXoffIn))); + FlowControl.XonXoffOut := StrToBool(IniFile.ReadString(Name, 'FlowControl.XonXoffOut', BoolToStr(FlowControl.XonXoffOut))); + FlowControl.XoffChar := StrToChar(IniFile.ReadString(Name, 'FlowControl.XoffChar', CharToStr(FlowControl.XoffChar))); + FlowControl.XonChar := StrToChar(IniFile.ReadString(Name, 'FlowControl.XonChar', CharToStr(FlowControl.XonChar))); + end; +end; + +// load settings from registry +procedure TCustomComPort.LoadRegistry(Reg: TRegistry); +begin + if spBasic in FStoredProps then + begin + Port := Reg.ReadString('Port'); + BaudRate := StrToBaudRate(Reg.ReadString('BaudRate')); + if BaudRate = brCustom then + CustomBaudRate := Reg.ReadInteger('CustomBaudRate'); + StopBits := StrToStopBits(Reg.ReadString('StopBits')); + DataBits := StrToDataBits(Reg.ReadString('DataBits')); + Parity.Bits := StrToParity(Reg.ReadString('Parity')); + FlowControl.FlowControl := StrToFlowControl(Reg.ReadString('FlowControl')); + end; + if spOthers in FStoredProps then + begin + EventChar := StrToChar(Reg.ReadString('EventChar')); + DiscardNull := StrToBool(Reg.ReadString('DiscardNull')); + end; + if spParity in FStoredProps then + begin + Parity.Check := StrToBool(Reg.ReadString('Parity.Check')); + Parity.Replace := StrToBool(Reg.ReadString('Parity.Replace')); + Parity.ReplaceChar := StrToChar(Reg.ReadString('Parity.ReplaceChar')); + end; + if spBuffer in FStoredProps then + begin + Buffer.OutputSize := Reg.ReadInteger('Buffer.OutputSize'); + Buffer.InputSize := Reg.ReadInteger('Buffer.InputSize'); + end; + if spTimeouts in FStoredProps then + begin + Timeouts.ReadInterval := Reg.ReadInteger('Timeouts.ReadInterval'); + Timeouts.ReadTotalConstant := Reg.ReadInteger('Timeouts.ReadTotalConstant'); + Timeouts.ReadTotalMultiplier := Reg.ReadInteger('Timeouts.ReadTotalMultiplier'); + Timeouts.WriteTotalConstant := Reg.ReadInteger('Timeouts.WriteTotalConstant'); + Timeouts.WriteTotalMultiplier := Reg.ReadInteger('Timeouts.WriteTotalMultiplier'); + end; + if spFlowControl in FStoredProps then + begin + FlowControl.ControlRTS := StrToRTS(Reg.ReadString('FlowControl.ControlRTS')); + FlowControl.ControlDTR := StrToDTR(Reg.ReadString('FlowControl.ControlDTR')); + FlowControl.DSRSensitivity := StrToBool(Reg.ReadString('FlowControl.DSRSensitivity')); + FlowControl.OutCTSFlow := StrToBool(Reg.ReadString('FlowControl.OutCTSFlow')); + FlowControl.OutDSRFlow := StrToBool(Reg.ReadString('FlowControl.OutDSRFlow')); + FlowControl.TxContinueOnXoff := StrToBool(Reg.ReadString('FlowControl.TxContinueOnXoff')); + FlowControl.XonXoffIn := StrToBool(Reg.ReadString('FlowControl.XonXoffIn')); + FlowControl.XonXoffOut := StrToBool(Reg.ReadString('FlowControl.XonXoffOut')); + FlowControl.XoffChar := StrToChar(Reg.ReadString('FlowControl.XoffChar')); + FlowControl.XonChar := StrToChar(Reg.ReadString('FlowControl.XonChar')); + end; +end; + +// initialize registry +procedure SetRegistry(Reg: TRegistry; Key: string; Name: string); +var + I: Integer; + Temp: string; +begin + I := Pos('\', Key); + if I > 0 then + begin + Temp := Copy(Key, 1, I - 1); + if UpperCase(Temp) = 'HKEY_LOCAL_MACHINE' then + Reg.RootKey := HKEY_LOCAL_MACHINE + else + if UpperCase(Temp) = 'HKEY_CURRENT_USER' then + Reg.RootKey := HKEY_CURRENT_USER; + Key := Copy(Key, I + 1, Length(Key) - I); + if Key[Length(Key)] <> '\' then + Key := Key + '\'; + Key := Key + Name; + Reg.OpenKey(Key, True); + end; +end; + +// store settings +procedure TCustomComPort.StoreSettings(StoreType: TStoreType; StoreTo: string); +var + IniFile: TIniFile; + Reg: TRegistry; +begin + try + if StoreType = stRegistry then + begin + Reg := TRegistry.Create; + try + SetRegistry(Reg, StoreTo, Name); + StoreRegistry(Reg); + finally + Reg.Free; + end + end else + begin + IniFile := TIniFile.Create(StoreTo); + try + StoreIniFile(IniFile); + finally + IniFile.Free; + end + end; + except + //raise EComPort.CreateNoWinCode + CallException(CError_StoreFailed); + end; +end; + +// load settings +procedure TCustomComPort.LoadSettings(StoreType: TStoreType; LoadFrom: string); +var + IniFile: TIniFile; + Reg: TRegistry; +begin + BeginUpdate; + try + try + if StoreType = stRegistry then + begin + Reg := TRegistry.Create; + try + SetRegistry(Reg, LoadFrom, Name); + LoadRegistry(Reg); + finally + Reg.Free; + end + end else + begin + IniFile := TIniFile.Create(LoadFrom); + try + LoadIniFile(IniFile); + finally + IniFile.Free; + end + end; + finally + EndUpdate; + end; + except + //raise EComPort.CreateNoWinCode + CallException(CError_LoadFailed); + end; +end; + +// register link from other component to TCustomComPort +procedure TCustomComPort.RegisterLink(AComLink: TComLink); +begin + if FLinks.IndexOf(Pointer(AComLink)) > -1 then + //raise EComPort.CreateNoWinCode + CallException(CError_RegFailed) + else + FLinks.Add(Pointer(AComLink)); + FHasLink := HasLink; +end; + +// unregister link from other component to TCustomComPort +procedure TCustomComPort.UnRegisterLink(AComLink: TComLink); +begin + if FLinks.IndexOf(Pointer(AComLink)) = -1 then + //raise EComPort.CreateNoWinCode + CallException(CError_RegFailed) + else + FLinks.Remove(Pointer(AComLink)); + FHasLink := HasLink; +end; + +// default actions on port events + +procedure TCustomComPort.DoBeforeClose; +begin + if Assigned(FOnBeforeClose) then + FOnBeforeClose(Self); +end; + +procedure TCustomComPort.DoBeforeOpen; +begin + if Assigned(FOnBeforeOpen) then + FOnBeforeOpen(Self); +end; + +procedure TCustomComPort.DoAfterOpen; +begin + if Assigned(FOnAfterOpen) then + FOnAfterOpen(Self); +end; + +procedure TCustomComPort.DoAfterClose; +begin + if Assigned(FOnAfterClose) then + FOnAfterClose(Self); +end; + +procedure TCustomComPort.DoRxChar(Count: Integer); +begin + if Assigned(FOnRxChar) then + FOnRxChar(Self, Count); +end; + +procedure TCustomComPort.DoRxBuf(const Buffer; Count: Integer); +begin + if Assigned(FOnRxBuf) then + FOnRxBuf(Self, Buffer, Count); +end; + +procedure TCustomComPort.DoBreak; +begin + if Assigned(FOnBreak) then + FOnBreak(Self); +end; + +procedure TCustomComPort.DoTxEmpty; +begin + if Assigned(FOnTxEmpty) + then FOnTxEmpty(Self); +end; + +procedure TCustomComPort.DoRing; +begin + if Assigned(FOnRing) then + FOnRing(Self); +end; + +procedure TCustomComPort.DoCTSChange(OnOff: Boolean); +begin + if Assigned(FOnCTSChange) then + FOnCTSChange(Self, OnOff); +end; + +procedure TCustomComPort.DoDSRChange(OnOff: Boolean); +begin + if Assigned(FOnDSRChange) then + FOnDSRChange(Self, OnOff); +end; + +procedure TCustomComPort.DoRLSDChange(OnOff: Boolean); +begin + if Assigned(FOnRLSDChange) then + FOnRLSDChange(Self, OnOff); +end; + +procedure TCustomComPort.DoError(Errors: TComErrors); +begin + if Assigned(FOnError) then + FOnError(Self, Errors); +end; + +procedure TCustomComPort.DoRxFlag; +begin + if Assigned(FOnRxFlag) then + FOnRxFlag(Self); +end; + +procedure TCustomComPort.DoRx80Full; +begin + if Assigned(FOnRx80Full) then + FOnRx80Full(Self); +end; + +// set signals to false on close, and to proper value on open, +// because OnXChange events are not called automatically +procedure TCustomComPort.CheckSignals(Open: Boolean); +begin + if Open then + begin + CallCTSChange; + CallDSRChange; + CallRLSDChange; + end else + begin + SendSignalToLink(leCTS, False); + SendSignalToLink(leDSR, False); + SendSignalToLink(leRLSD, False); + DoCTSChange(False); + DoDSRChange(False); + DoRLSDChange(False); + end; +end; + +// called in response to EV_X events, except CallXClose, CallXOpen + +procedure TCustomComPort.CallAfterClose; +begin + SendSignalToLink(leConn, False); + DoAfterClose; +end; + +procedure TCustomComPort.CallAfterOpen; +begin + SendSignalToLink(leConn, True); + DoAfterOpen; + CheckSignals(True); +end; + +procedure TCustomComPort.CallBeforeClose; +begin + // shutdown com signals manually + CheckSignals(False); + DoBeforeClose; +end; + +procedure TCustomComPort.CallBeforeOpen; +begin + DoBeforeOpen; +end; + +procedure TCustomComPort.CallBreak; +begin + DoBreak; +end; + +procedure TCustomComPort.CallCTSChange; +var + OnOff: Boolean; +begin + OnOff := csCTS in Signals; + // check for linked components + SendSignalToLink(leCTS, OnOff); + DoCTSChange(OnOff); +end; + +procedure TCustomComPort.CallDSRChange; +var + OnOff: Boolean; +begin + OnOff := csDSR in Signals; + // check for linked components + SendSignalToLink(leDSR, OnOff); + DoDSRChange(OnOff); +end; + +procedure TCustomComPort.CallRLSDChange; +var + OnOff: Boolean; +begin + OnOff := csRLSD in Signals; + // check for linked components + SendSignalToLink(leRLSD, OnOff); + DoRLSDChange(OnOff); +end; + +procedure TCustomComPort.CallError; +var + Errors: TComErrors; +begin + Errors := LastErrors; + if Errors <> [] then + DoError(Errors); +end; + +procedure TCustomComPort.CallRing; +begin + NotifyLink(leRing); + DoRing; +end; + +procedure TCustomComPort.CallRx80Full; +begin + DoRx80Full; +end; + +procedure TCustomComPort.CallRxChar; +var + Count: Integer; + + // read from input buffer + procedure PerformRead(var P: Pointer); + begin + GetMem(P, Count); + Read(P^, Count); + // call OnRxBuf event + DoRxBuf(P^, Count); + end; + + // check if any component is linked, to OnRxChar event + procedure CheckLinks; + {$WARNINGS OFF} + var + I: Integer; + P: Pointer; + ComLink: TComLink; + ReadFromBuffer: Boolean; + begin + // examine links + if (Count > 0) and (not TriggersOnRxChar) then + begin + ReadFromBuffer := False; + try + // cycle through links + for I := 0 to FLinks.Count - 1 do + begin + ComLink := TComLink(FLinks[I]); + if Assigned(ComLink.OnRxBuf) then + begin + // link to OnRxChar event found + if not ReadFromBuffer then + begin + // TCustomComPort must read from comport, so OnRxChar event is + // not triggered + ReadFromBuffer := True; + PerformRead(P); + end; + // send data to linked component + ComLink.OnRxBuf(Self, P^, Count); + end + end; + if (not ReadFromBuffer) and (not FTriggersOnRxChar) then + begin + ReadFromBuffer := True; + PerformRead(P); + end; + finally + if ReadFromBuffer then + begin + FreeMem(P); + // data is already out of buffer, prevent from OnRxChar event to occur + Count := 0; + end; + end; + end; + end; + +begin + Count := InputCount; + if Count > 0 then + SendSignalToLink(leRx, True); + CheckLinks; + if Count > 0 then + DoRxChar(Count); +end; + +procedure TCustomComPort.CallRxFlag; +begin + NotifyLink(leRxFlag); + DoRxFlag; +end; + +procedure TCustomComPort.CallTxEmpty; +begin + SendSignalToLink(leTx, False); + NotifyLink(leTxEmpty); + DoTxEmpty; +end; + +// returns true if it has least one component linked to OnRxBuf event +function TCustomComPort.HasLink: Boolean; +var + I: Integer; + ComLink: TComLink; +begin + Result := False; + // examine links + if FLinks.Count > 0 then + for I := 0 to FLinks.Count - 1 do + begin + ComLink := TComLink(FLinks[I]); + if Assigned(ComLink.OnRxBuf) then + Result := True; + end; +end; + +// send TxBuf notify to link +procedure TCustomComPort.TxNotifyLink(const Buffer; Count: Integer); +var + I: Integer; + ComLink: TComLink; +begin + if (FLinks.Count > 0) then + for I := 0 to FLinks.Count - 1 do + begin + ComLink := TComLink(FLinks[I]); + if Assigned(ComLink.OnTxBuf) then + ComLink.OnTxBuf(Self, Buffer, Count); + end; +end; + +// send event notification to link +procedure TCustomComPort.NotifyLink(FLinkEvent: TComLinkEvent); +var + I: Integer; + ComLink: TComLink; + Event: TNotifyEvent; +begin + if (FLinks.Count > 0) then + for I := 0 to FLinks.Count - 1 do + begin + ComLink := TComLink(FLinks[I]); + Event := nil; + case FLinkEvent of + leRing: Event := ComLink.OnRing; + leTxEmpty: Event := ComLink.OnTxEmpty; + leRxFlag: Event := ComLink.OnRxFlag; + end; + if Assigned(Event) then + Event(Self); + end; +end; + +// send signal to linked components +procedure TCustomComPort.SendSignalToLink(Signal: TComLinkEvent; OnOff: Boolean); +var + I: Integer; + ComLink: TComLink; + SignalEvent: TComSignalEvent; +begin + if (FLinks.Count > 0) then + // cycle through links + for I := 0 to FLinks.Count - 1 do + begin + ComLink := TComLink(FLinks[I]); + SignalEvent := nil; + case Signal of + leCTS: SignalEvent := ComLink.OnCTSChange; + leDSR: SignalEvent := ComLink.OnDSRChange; + leRLSD: SignalEvent := ComLink.OnRLSDChange; + leTx: SignalEvent := ComLink.OnTx; + leRx: SignalEvent := ComLink.OnRx; + leConn: SignalEvent := ComLink.OnConn; + end; + // if linked, trigger event + if Assigned(SignalEvent) then + SignalEvent(Self, OnOff); + end; +end; + +// set connected property, same as Open/Close methods +procedure TCustomComPort.SetConnected(const Value: Boolean); +begin + if not ((csDesigning in ComponentState) or (csLoading in ComponentState)) then + begin + if Value <> FConnected then + if Value then + Open + else + Close; + end + else + FConnected := Value; +end; + +// set baud rate +procedure TCustomComPort.SetBaudRate(const Value: TBaudRate); +begin + if Value <> FBaudRate then + begin + FBaudRate := Value; + // if possible, apply settings + ApplyDCB; + end; +end; + +// set custom baud rate +procedure TCustomComPort.SetCustomBaudRate(const Value: Integer); +begin + if Value <> FCustomBaudRate then + begin + FCustomBaudRate := Value; + ApplyDCB; + end; +end; + +// set data bits +procedure TCustomComPort.SetDataBits(const Value: TDataBits); +begin + if Value <> FDataBits then + begin + FDataBits := Value; + ApplyDCB; + end; +end; + +// set discard null characters +procedure TCustomComPort.SetDiscardNull(const Value: Boolean); +begin + if Value <> FDiscardNull then + begin + FDiscardNull := Value; + ApplyDCB; + end; +end; + +// set event characters +procedure TCustomComPort.SetEventChar(const Value: Char); +begin + if Value <> FEventChar then + begin + FEventChar := Value; + ApplyDCB; + end; +end; + +// set port +procedure TCustomComPort.SetPort(const Value: TPort); +begin + // 11.1.2001 Ch. Kaufmann; removed function ComString, because there can be com ports + // with names other than COMn. + if Value <> FPort then + begin + FPort := Value; + if FConnected and not ((csDesigning in ComponentState) or + (csLoading in ComponentState)) then + begin + Close; + Open; + end; + end; +end; + +// set stop bits +procedure TCustomComPort.SetStopBits(const Value: TStopBits); +begin + if Value <> FStopBits then + begin + FStopBits := Value; + ApplyDCB; + end; +end; + +// set event synchronization method +procedure TCustomComPort.SetSyncMethod(const Value: TSyncMethod); +begin + if Value <> FSyncMethod then + begin + if FConnected and not ((csDesigning in ComponentState) or + (csLoading in ComponentState)) + then + //raise EComPort.CreateNoWinCode + CallException(CError_ConnChangeProp) + else + FSyncMethod := Value; + end; +end; + +// sets RxChar triggering +procedure TCustomComPort.SetTriggersOnRxChar(const Value: Boolean); +begin + if FHasLink then + //raise EComPort.CreateNoWinCode + CallException(CError_HasLink); + FTriggersOnRxChar := Value; +end; + +// sets event thread priority +procedure TCustomComPort.SetEventThreadPriority(const Value: TThreadPriority); +begin + if Value <> FEventThreadPriority then + begin + if FConnected and not ((csDesigning in ComponentState) or + (csLoading in ComponentState)) + then + //raise EComPort.CreateNoWinCode + CallException(CError_ConnChangeProp) + else + FEventThreadPriority := Value; + end; +end; + +// returns true if RxChar is triggered when data arrives input buffer +function TCustomComPort.GetTriggersOnRxChar: Boolean; +begin + Result := FTriggersOnRxChar and (not FHasLink); +end; + +// set flow control +procedure TCustomComPort.SetFlowControl(const Value: TComFlowControl); +begin + FFlowControl.Assign(Value); + ApplyDCB; +end; + +// set parity +procedure TCustomComPort.SetParity(const Value: TComParity); +begin + FParity.Assign(Value); + ApplyDCB; +end; + +// set timeouts +procedure TCustomComPort.SetTimeouts(const Value: TComTimeouts); +begin + FTimeouts.Assign(Value); + ApplyTimeouts; +end; + +// set buffer +procedure TCustomComPort.SetBuffer(const Value: TComBuffer); +begin + FBuffer.Assign(Value); + ApplyBuffer; +end; + +(***************************************** + * TComDataPacket component * + *****************************************) + +// create component +constructor TComDataPacket.Create(AOwner: TComponent); +begin + inherited Create(AOwner); + FComLink := TComLink.Create; + FComLink.OnRxBuf := RxBuf; + FMaxBufferSize := 1024; +end; + +// destroy component +destructor TComDataPacket.Destroy; +begin + ComPort := nil; + FComLink.Free; + inherited Destroy; +end; + +// add custom data to packet buffer +procedure TComDataPacket.AddData(const Str: string); +begin + if ValidStop then + begin + Buffer := Buffer + Str; + HandleBuffer; + end + else + DoPacket(Str); +end; + +// remove ComPort property if being destroyed +procedure TComDataPacket.Notification(AComponent: TComponent; + Operation: TOperation); +begin + inherited Notification(AComponent, Operation); + if (AComponent = FComPort) and (Operation = opRemove) then + ComPort := nil; +end; + +// call OnDiscard +procedure TComDataPacket.DoDiscard(const Str: string); +begin + if Assigned(FOnDiscard) then + FOnDiscard(Self, Str); +end; + +// call OnPacket +procedure TComDataPacket.DoPacket(const Str: string); +begin + if Assigned(FOnPacket) then + FOnPacket(Self, Str); +end; + +// call OnCustomStart +procedure TComDataPacket.DoCustomStart(const Str: string; + var Pos: Integer); +begin + if Assigned(FOnCustomStart) then + FOnCustomStart(Self, Str, Pos); +end; + +// call OnCustomStop +procedure TComDataPacket.DoCustomStop(const Str: string; var Pos: Integer); +begin + if Assigned(FOnCustomStop) then + FOnCustomStop(Self, Str, Pos); +end; + +// discard start and stop strings +procedure TComDataPacket.CheckIncludeStrings(var Str: string); +var + LenStart, LenStop: Integer; +begin + if FIncludeStrings then + Exit; + LenStart := Length(FStartString); + LenStop := Length(FStopString); + // remove start string + if Pos(Upper(FStartString), Upper(Str)) = 1 then + Str := Copy(Str, LenStart + 1, Length(Str) - LenStart); + // remove stop string + if Pos(Upper(FStopString), Upper(Str)) = (Length(Str) - LenStop + 1) then + Str := Copy(Str, 1, Length(Str) - LenStop); +end; + +// upper case +function TComDataPacket.Upper(const Str: string): string; +begin + if FCaseInsensitive then + Result := UpperCase(Str) + else + Result := Str; +end; + +// split buffer in packets +procedure TComDataPacket.HandleBuffer; + + procedure DiscardPacketToPos(Pos: Integer); + var + Str: string; + begin + FInPacket := True; + if Pos > 1 then + begin + Str := Copy(Buffer, 1, Pos - 1); // some discarded data + Buffer := Copy(Buffer, Pos, Length(Buffer) - Pos + 1); + DoDiscard(Str); + end; + end; + + procedure FormPacket(CutSize: Integer); + var + Str: string; + begin + Str := Copy(Buffer, 1, CutSize); + Buffer := Copy(Buffer, CutSize + 1, Length(Buffer) - CutSize); + CheckIncludeStrings(Str); + DoPacket(Str); + end; + + procedure StartPacket; + var + Found: Integer; + begin + // check for custom start condition + Found := -1; + DoCustomStart(Buffer, Found); + if Found > 0 then + DiscardPacketToPos(Found); + if Found = -1 then + begin + if Length(FStartString) > 0 then // start string valid + begin + Found := Pos(Upper(FStartString), Upper(Buffer)); + if Found > 0 then + DiscardPacketToPos(Found); + end + else + FInPacket := True; + end; + end; + + procedure EndPacket; + var + Found, CutSize, Len: Integer; + begin + // check for custom stop condition + Found := -1; + DoCustomStop(Buffer, Found); + if Found > 0 then + begin + // custom stop condition detected + CutSize := Found; + FInPacket := False; + end + else + if Found = -1 then + begin + Len := Length(Buffer); + if (FSize > 0) and (Len >= FSize) then + begin + // size stop condition detected + FInPacket := False; + CutSize := FSize; + end + else + begin + Len := Length(FStartString); + Found := Pos(Upper(FStopString), + Upper(Copy(Buffer, Len + 1, Length(Buffer) - Len))); + if Found > 0 then + begin + // stop string stop condition detected + CutSize := Found + Length(FStopString) + Len - 1; + FInPacket := False; + end; + end; + end; + if not FInPacket then + FormPacket(CutSize); // create packet + end; + + function IsBufferTooLarge: Boolean; + begin + Result := (Length(Buffer) >= FMaxBufferSize) and (FMaxBufferSize > 0); + end; + +begin + try + if not FInPacket then + StartPacket; + if FInPacket then + begin + EndPacket; + if not FInPacket then + HandleBuffer; + end; + finally + if IsBufferTooLarge then + EmptyBuffer; + end; +end; + +// is stop condition valid? +function TComDataPacket.ValidStop: Boolean; +begin + Result := (FSize > 0) or (Length(FStopString) > 0) + or (Assigned(FOnCustomStop)); +end; + +// receive data +procedure TComDataPacket.ResetBuffer; +begin + EmptyBuffer; +end; + +procedure TComDataPacket.RxBuf(Sender: TObject; const Buffer; Count: Integer); +var sa:AnsiString; Str: string; + i:integer; +begin + SetLength(Str, Count); + SetLength(Sa, Count); + Move(Buffer, Sa[1], Count); + {$IFDEF Unicode} + if length(sa)>0 then + for i := 1 to length(sa) do str[i] := char(byte(sa[i])); + {$ELSE} str := sa; {$ENDIF} + AddData(Str); +end; + +// empty buffer +procedure TComDataPacket.EmptyBuffer; +begin + if Buffer <> '' then + begin + try + DoDiscard(Buffer); + finally + Buffer := ''; + FInPacket := False; + end; + end; +end; + +// set com port +procedure TComDataPacket.SetComPort(const Value: TCustomComPort); +begin + if Value <> FComPort then + begin + if FComPort <> nil then + FComPort.UnRegisterLink(FComLink); + FComPort := Value; + if FComPort <> nil then + begin + FComPort.FreeNotification(Self); + FComPort.RegisterLink(FComLink); + end; + end; +end; + +// set case sensitivity +procedure TComDataPacket.SetCaseInsensitive(const Value: Boolean); +begin + if FCaseInsensitive <> Value then + begin + FCaseInsensitive := Value; + if not (csLoading in ComponentState) then + EmptyBuffer; + end; +end; + +// set packet size +procedure TComDataPacket.SetSize(const Value: Integer); +begin + if FSize <> Value then + begin + FSize := Value; + if not (csLoading in ComponentState) then + EmptyBuffer; + end; +end; + +// set start string +procedure TComDataPacket.SetStartString(const Value: string); +begin + if FStartString <> Value then + begin + FStartString := Value; + if not (csLoading in ComponentState) then + EmptyBuffer; + end; +end; + +// set stop string +procedure TComDataPacket.SetStopString(const Value: string); +begin + if FStopString <> Value then + begin + FStopString := Value; + if not (csLoading in ComponentState) then + EmptyBuffer; + end; +end; + +(***************************************** + * EComPort exception * + *****************************************) + +// create stream +constructor TComStream.Create(AComPort: TCustomComPort); +begin + inherited Create; + FComPort := AComPort; +end; + +// read from stream +function TComStream.Read(var Buffer; Count: Integer): Longint; +begin + FComPort.Read(Buffer, Count); +end; + +// write to stream +function TComStream.Write(const Buffer; Count: Integer): Longint; +begin + FComPort.Write(Buffer, Count); +end; + +// seek always to 0 +function TComStream.Seek(Offset: Integer; Origin: Word): Longint; +begin + Result := 0; +end; + +(***************************************** + * EComPort exception * + *****************************************) + +// create exception with windows error code +constructor EComPort.Create(ACode: Integer; AWinCode: Integer); +begin + FWinCode := AWinCode; + FCode := ACode; + inherited CreateFmt(ComErrorMessages[ACode] + ' (Error: %d)', [AWinCode]); +end; + +// create exception +constructor EComPort.CreateNoWinCode(ACode: Integer); +begin + FWinCode := -1; + FCode := ACode; + inherited Create(ComErrorMessages[ACode]); +end; + +(***************************************** + * other procedures/functions * + *****************************************) + +// initialization of PAsync variables used in asynchronous calls +procedure InitAsync(var AsyncPtr: PAsync); +begin + New(AsyncPtr); + with AsyncPtr^ do + begin + FillChar(Overlapped, SizeOf(TOverlapped), 0); + Overlapped.hEvent := CreateEvent(nil, True, True, nil); + Data := nil; + Size := 0; + end; +end; + +// clean-up of PAsync variable +procedure DoneAsync(var AsyncPtr: PAsync); +begin + with AsyncPtr^ do + begin + CloseHandle(Overlapped.hEvent); + if Data <> nil then + FreeMem(Data); + end; + Dispose(AsyncPtr); + AsyncPtr := nil; +end; + +procedure EnumComPorts(Ports: TStrings); +var + KeyHandle: HKEY; + ErrCode, Index: Integer; + ValueName, Data: string; + ValueLen, DataLen, ValueType: DWORD; + TmpPorts: TStringList; +begin + ErrCode := RegOpenKeyEx( + HKEY_LOCAL_MACHINE, + 'HARDWARE\DEVICEMAP\SERIALCOMM', + 0, + KEY_READ, + KeyHandle); + + if ErrCode <> ERROR_SUCCESS then + begin + //raise EComPort.Create(CError_RegError, ErrCode); + exit; + end; + + TmpPorts := TStringList.Create; + try + Index := 0; + repeat + ValueLen := 256; + DataLen := 256; + SetLength(ValueName, ValueLen); + SetLength(Data, DataLen); + ErrCode := RegEnumValue( + KeyHandle, + Index, + PChar(ValueName), + {$IFDEF DELPHI_4_OR_HIGHER} + Cardinal(ValueLen), + {$ELSE} + ValueLen, + {$ENDIF} + nil, + @ValueType, + PByte(PChar(Data)), + @DataLen); + + if ErrCode = ERROR_SUCCESS then + begin + SetLength(Data, DataLen - 1); + TmpPorts.Add(Data); + Inc(Index); + end + else + if ErrCode <> ERROR_NO_MORE_ITEMS then break; + //raise EComPort.Create(CError_RegError, ErrCode); + + until (ErrCode <> ERROR_SUCCESS) ; + + TmpPorts.Sort; + Ports.Assign(TmpPorts); + finally + RegCloseKey(KeyHandle); + TmpPorts.Free; + end; + +end; + +// string to baud rate +function StrToBaudRate(Str: string): TBaudRate; +var + I: TBaudRate; +begin + I := Low(TBaudRate); + while (I <= High(TBaudRate)) do + begin + if UpperCase(Str) = UpperCase(BaudRateToStr(TBaudRate(I))) then + Break; + I := Succ(I); + end; + if I > High(TBaudRate) then + Result := br9600 + else + Result := I; +end; + +// string to stop bits +function StrToStopBits(Str: string): TStopBits; +var + I: TStopBits; +begin + I := Low(TStopBits); + while (I <= High(TStopBits)) do + begin + if UpperCase(Str) = UpperCase(StopBitsToStr(TStopBits(I))) then + Break; + I := Succ(I); + end; + if I > High(TStopBits) then + Result := sbOneStopBit + else + Result := I; +end; + +// string to data bits +function StrToDataBits(Str: string): TDataBits; +var + I: TDataBits; +begin + I := Low(TDataBits); + while (I <= High(TDataBits)) do + begin + if UpperCase(Str) = UpperCase(DataBitsToStr(I)) then + Break; + I := Succ(I); + end; + if I > High(TDataBits) then + Result := dbEight + else + Result := I; +end; + +// string to parity +function StrToParity(Str: string): TParityBits; +var + I: TParityBits; +begin + I := Low(TParityBits); + while (I <= High(TParityBits)) do + begin + if UpperCase(Str) = UpperCase(ParityToStr(I)) then + Break; + I := Succ(I); + end; + if I > High(TParityBits) then + Result := prNone + else + Result := I; +end; + +// string to flow control +function StrToFlowControl(Str: string): TFlowControl; +var + I: TFlowControl; +begin + I := Low(TFlowControl); + while (I <= High(TFlowControl)) do + begin + if UpperCase(Str) = UpperCase(FlowControlToStr(I)) then + Break; + I := Succ(I); + end; + if I > High(TFlowControl) then + Result := fcCustom + else + Result := I; +end; + +// baud rate to string +function BaudRateToStr(BaudRate: TBaudRate): string; +const + BaudRateStrings: array[TBaudRate] of string = ('Custom', '110', '300', '600', + '1200', '2400', '4800', '9600', '14400', '19200', '38400', '56000', '57600', + '115200', '128000', '256000'); +begin + Result := BaudRateStrings[BaudRate]; +end; + +// stop bits to string +function StopBitsToStr(StopBits: TStopBits): string; +const + StopBitsStrings: array[TStopBits] of string = ('1', '1.5', '2'); +begin + Result := StopBitsStrings[StopBits]; +end; + +// data bits to string +function DataBitsToStr(DataBits: TDataBits): string; +const + DataBitsStrings: array[TDataBits] of string = ('5', '6', '7', '8'); +begin + Result := DataBitsStrings[DataBits]; +end; + +// parity to string +function ParityToStr(Parity: TParityBits): string; +const + ParityBitsStrings: array[TParityBits] of string = ('None', 'Odd', 'Even', + 'Mark', 'Space'); +begin + Result := ParityBitsStrings[Parity]; +end; + +// flow control to string +function FlowControlToStr(FlowControl: TFlowControl): string; +const + FlowControlStrings: array[TFlowControl] of string = ('Hardware', + 'Software', 'None', 'Custom'); +begin + Result := FlowControlStrings[FlowControl]; +end; + +initialization + ComErrorMessages[1]:='Unable to open com port'; + ComErrorMessages[2]:='WriteFile function failed'; + ComErrorMessages[3]:='ReadFile function failed'; + ComErrorMessages[4]:='Invalid Async parameter'; + ComErrorMessages[5]:='PurgeComm function failed'; + ComErrorMessages[6]:='Unable to get async status'; + ComErrorMessages[7]:='SetCommState function failed'; + ComErrorMessages[8]:='SetCommTimeouts failed'; + ComErrorMessages[9]:='SetupComm function failed'; + ComErrorMessages[10]:='ClearCommError function failed'; + ComErrorMessages[11]:='GetCommModemStatus function failed'; + ComErrorMessages[12]:='EscapeCommFunction function failed'; + ComErrorMessages[13]:='TransmitCommChar function failed'; + ComErrorMessages[14]:='Cannot set property while connected'; + ComErrorMessages[15]:='EnumPorts function failed'; + ComErrorMessages[16]:='Failed to store settings'; + ComErrorMessages[17]:='Failed to load settings'; + ComErrorMessages[18]:='Link (un)registration failed'; + ComErrorMessages[19]:='Cannot change led state if ComPort is selected'; + ComErrorMessages[20]:='Cannot wait for event if event thread is created'; + ComErrorMessages[21]:='WaitForEvent method failed'; + ComErrorMessages[22]:='A component is linked to OnRxBuf event'; + ComErrorMessages[23]:='Registry error'; + ComErrorMessages[24]:='Port Not Open';// CError_PortNotOpen + + +end. diff --git a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm index 5afe5dc3..67620e7d 100644 Binary files a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm and b/Host/Source/MicroBoot/interfaces/uart/XcpSettings.dfm differ diff --git a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas index 9867bf5b..f2d34ab6 100644 --- a/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas +++ b/Host/Source/MicroBoot/interfaces/uart/XcpSettings.pas @@ -36,7 +36,7 @@ interface //*************************************************************************************** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ComCtrls, ExtCtrls, IniFiles; + StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage; //*************************************************************************************** diff --git a/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas b/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas index ec5e3b33..2f7222d2 100644 --- a/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas +++ b/Host/Source/MicroBoot/interfaces/uart/XcpTransport.pas @@ -36,7 +36,7 @@ interface // Includes //*************************************************************************************** uses - Windows, Messages, SysUtils, Classes, Forms, CPDrv, IniFiles; + Windows, Messages, SysUtils, Classes, Forms, CPort, IniFiles; //*************************************************************************************** @@ -54,7 +54,7 @@ type public packetData : array[0..kMaxPacketSize-1] of Byte; packetLen : Word; - sciDriver : TCommPortDriver; + sciDriver : TComPort; constructor Create; procedure Configure(iniFile : string); function Connect : Boolean; @@ -80,14 +80,12 @@ begin inherited Create; // create a sci driver instance - sciDriver := TCommPortDriver.Create(nil); + sciDriver := TComPort.Create(nil); // init sci settings - sciDriver.DataBits := db8BITS; - sciDriver.StopBits := sb1BITS; - sciDriver.Parity := ptNONE; - sciDriver.SwFlow := sfNONE; - sciDriver.PollingDelay := 5; + sciDriver.DataBits := dbEight; + sciDriver.StopBits := sbOneStopBit; + sciDriver.Parity.Bits := prNone; // reset packet length packetLen := 0; @@ -149,8 +147,7 @@ begin // configure port configIndex := settingsIni.ReadInteger('sci', 'port', 0); - sciDriver.Port := pnCustom; - sciDriver.PortName := Format( '\\.\COM%d', [ord(configIndex + 1)] ); + sciDriver.Port := Format( 'COM%d', [ord(configIndex + 1)] ); // release ini file object settingsIni.Free; @@ -167,9 +164,8 @@ end; //*** end of Configure *** //*************************************************************************************** function TXcpTransport.Connect : Boolean; begin - result := true; - if not sciDriver.Connect then - result := false; + sciDriver.Open; + result := sciDriver.Connected; end; //*** end of Connect *** @@ -199,7 +195,6 @@ var msgData : array of Byte; resLen : byte; cnt : byte; - dwEnd :DWord; begin // init the return value result := false; @@ -222,35 +217,26 @@ begin msgData[cnt+1] := packetData[cnt]; end; + // configure transmit timeout. timeout = (MULTIPLIER) * number_of_bytes + CONSTANT + sciDriver.Timeouts.WriteTotalConstant := 0; + sciDriver.Timeouts.WriteTotalMultiplier := timeOutms div (packetLen+1); + // submit the packet transmission request - if sciDriver.SendData(@msgData[0], packetLen+1) <> (packetLen+1) then + if sciDriver.Write(msgData[0], packetLen+1) <> (packetLen+1) then begin // unable to submit tx request Exit; end; - // compute timeout time - dwEnd := GetTickCount + timeOutms; + // configure reception timeout. timeout = (MULTIPLIER) * number_of_bytes + CONSTANT + sciDriver.Timeouts.ReadTotalConstant := timeOutms; + sciDriver.Timeouts.ReadTotalMultiplier := 0; - // configure timeout for first byte - sciDriver.InputTimeout := timeOutms; - - // receive the first byte which holds the packet length - if sciDriver.ReadByte(resLen) = true then + // receive the first byte which should hold the packet length + if sciDriver.Read(resLen, 1) = 1 then begin - timeOutms := GetTickCount; - if timeOutms < dwEnd then - begin - // configure timeout for remaining bytes - sciDriver.InputTimeout := dwEnd - timeOutms; - end - else - begin - Exit; // timed out - end; - // receive the actual packet data - if sciDriver.ReadData(@packetData[0], resLen) = resLen then + if sciDriver.Read(packetData[0], resLen) = resLen then begin packetLen := resLen; result := true; @@ -268,7 +254,7 @@ end; //*** end of SendPacket *** //*************************************************************************************** procedure TXcpTransport.Disconnect; begin - sciDriver.Disconnect; + sciDriver.Close; end; //*** end of Disconnect *** diff --git a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.cfg b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.cfg deleted file mode 100644 index 7e67a882..00000000 --- a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.cfg +++ /dev/null @@ -1,35 +0,0 @@ --$A+ --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I+ --$J+ --$K- --$L+ --$M- --$N+ --$O+ --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E../../../../ --LNc:\borland\delphi4\Lib diff --git a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dof b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dof deleted file mode 100644 index 0e2c2a16..00000000 --- a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dof +++ /dev/null @@ -1,87 +0,0 @@ -[Compiler] -A=1 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=1 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=../../../../ -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40 -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1031 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[Excluded Packages] -$(DELPHI)\Lib\dclusr40.bpl=Borland User -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlOutputDirectorry] -Count=2 -Item0=../../../../ -Item1=../../../ diff --git a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr index ca070952..5f17d32b 100644 --- a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr +++ b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dpr @@ -51,8 +51,7 @@ uses XcpLoader in '..\XcpLoader.pas', XcpTransport in 'XcpTransport.pas', XcpSettings in 'XcpSettings.pas' {XcpSettingsForm}, - CPDrv in 'CPDrv.pas'; - + CPort in 'CPort.pas'; //*************************************************************************************** // Global Constants @@ -224,7 +223,7 @@ begin end; // update the log - MbiCallbackOnLog(logStr); + MbiCallbackOnLog(ShortString(logStr)); // update loop variables len := len - currentWriteCnt; @@ -258,25 +257,25 @@ begin // connect the transport layer MbiCallbackOnInfo('Connecting to the COM port.'); - MbiCallbackOnLog('Connecting to the COM port. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connecting to the COM port. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; if not loader.Connect then begin // update the user info MbiCallbackOnError('Could not connect to COM port. Check your configuration.'); - MbiCallbackOnLog('Could not connect to COM port. Check your configuration and try again. t='+TimeToStr(Time)); + MbiCallbackOnLog('Could not connect to COM port. Check your configuration and try again. t='+ShortString(TimeToStr(Time))); Exit; end; //---------------- start the programming session -------------------------------------- - MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time))); // try initial connect via XCP if loader.StartProgrammingSession <> kProgSessionStarted then begin // update the user info MbiCallbackOnInfo('Could not connect. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // continuously try to connect via XCP true the backdoor sessionStartResult := kProgSessionGenericError; @@ -296,7 +295,7 @@ begin // don't retry if the error was caused by not being able to unprotect the programming resource if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); Exit; end; @@ -311,7 +310,7 @@ begin end; // still here so programming session was started - MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time))); // create the datafile object datafile := TXcpDataFile.Create(progfile); @@ -336,16 +335,16 @@ begin datafile.GetRegionInfo(regionCnt, addr, len); // erase the memory - MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Clearing Memory '+ShortString(Format('addr:0x%x,len:0x%x',[addr,len]))+'. t='+ShortString(TimeToStr(Time))); if not loader.ClearMemory(addr, len) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not clear memory ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not clear memory ('+errorInfo+').'); + MbiCallbackOnLog('Could not clear memory ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not clear memory ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Memory cleared. t='+TimeToStr(Time)); + MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time))); end; //---------------- next program the memory regions ------------------------------------ @@ -369,18 +368,18 @@ begin if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen; // program the data - MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming Data '+ShortString(Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt]))+'. t='+ShortString(TimeToStr(Time))); LogData(@progdata[bufferOffset], currentWriteCnt); if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not program data ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not program data ('+errorInfo+').'); + MbiCallbackOnLog('Could not program data ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not program data ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Data Programmed. t='+TimeToStr(Time)); + MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time))); // update progress progress := progress + currentWriteCnt; @@ -392,30 +391,29 @@ begin bufferOffset := bufferOffset + currentWriteCnt; // update the user info - MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])); + MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]))); end; end; //---------------- stop the programming session --------------------------------------- - MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Stopping the programming session. t='+ShortString(TimeToStr(Time))); if not loader.StopProgrammingSession then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not stop the programming session ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not stop the programming session ('+errorInfo+').'); + MbiCallbackOnLog('Could not stop the programming session ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not stop the programming session ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Programming session stopped. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time))); // all done so set progress to 100% and finish up progress := datafile.GetDataCnt; datafile.Free; MbiCallbackOnProgress(progress); - MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time)); + MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time))); MbiCallbackOnDone; - end; //*** end of OnTimeout *** @@ -477,7 +475,7 @@ begin timer.Enabled := True; // store the program's filename - progfile := fileName; + progfile := String(fileName); end; //*** end of MbiStart *** @@ -495,7 +493,7 @@ begin stopRequest := true; // disconnect the transport layer - MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time)); + MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time))); loader.Disconnect; end; //*** end of MbiStop *** @@ -614,15 +612,15 @@ end; //*** end of MbiConfigure *** //*************************************************************************************** exports //--- begin of don't change --- - MbiInit index 1, - MbiStart index 2, - MbiStop index 3, - MbiDeInit index 4, - MbiName index 5, - MbiDescription index 6, - MbiVersion index 7, - MbiConfigure index 8, - MbiVInterface index 9; + MbiInit, + MbiStart, + MbiStop, + MbiDeInit, + MbiName, + MbiDescription, + MbiVersion, + MbiConfigure, + MbiVInterface; //--- end of don't change --- end. diff --git a/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj new file mode 100644 index 00000000..62c0ad2e --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/uart/openblt_uart.dproj @@ -0,0 +1,120 @@ + + + {38BAA5EC-0626-4775-9516-B3DED4560560} + openblt_uart.dpr + True + Debug + 1 + Library + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage) + false + false + 1031 + 00400000 + 1 + 1 + true + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + openblt_uart + true + false + true + ../../../../ + 1 + + + 1033 + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + + + RELEASE;$(DCC_Define) + 0 + false + 0 + + + DEBUG;$(DCC_Define) + true + false + + + 1033 + C:\Work\software\OpenBLT\Host\MicroBoot.exe + (None) + true + + + + MainSource + + + + + + + +
XcpSettingsForm
+ + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + openblt_uart.dpr + + + + True + + + 12 + + + + diff --git a/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas b/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas index 12130645..c7df7292 100644 --- a/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas +++ b/Host/Source/MicroBoot/interfaces/usb/UsbBulkLib.pas @@ -89,7 +89,7 @@ external DLL_Name; //*************************************************************************************** -// NAME: UblDllTransmit +// NAME: UblTransmit // PARAMETER: data pointer to byte array with transmit data. // len number of bytes to transmit. // RETURN VALUE: UBL_OKAY if successful, UBL_ERROR otherwise. @@ -104,7 +104,7 @@ external DLL_Name; //*************************************************************************************** -// NAME: UblDllReceive +// NAME: UblReceive // PARAMETER: data pointer to byte array where the data will be stored. // len number of bytes to receive. // timeout max time in milliseconds for the read to complete. diff --git a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm b/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm index 64f4f177..585cc2ee 100644 Binary files a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm and b/Host/Source/MicroBoot/interfaces/usb/XcpSettings.dfm differ diff --git a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas b/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas index e78cdd96..f18a6271 100644 --- a/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas +++ b/Host/Source/MicroBoot/interfaces/usb/XcpSettings.pas @@ -36,7 +36,7 @@ interface //*************************************************************************************** uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, - StdCtrls, ComCtrls, ExtCtrls, IniFiles; + StdCtrls, ComCtrls, ExtCtrls, IniFiles, Vcl.Imaging.pngimage; //*************************************************************************************** @@ -102,7 +102,8 @@ implementation procedure TXcpSettingsForm.btnOKClick(Sender: TObject); begin ModalResult := mrOK; -end; //*** end of btnOKClick *** +end; +//*** end of btnOKClick *** //*************************************************************************************** diff --git a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.cfg b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.cfg deleted file mode 100644 index 929df35b..00000000 --- a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.cfg +++ /dev/null @@ -1,35 +0,0 @@ --$A+ --$B- --$C+ --$D+ --$E- --$F- --$G+ --$H+ --$I+ --$J+ --$K- --$L+ --$M- --$N+ --$O+ --$P+ --$Q- --$R- --$S- --$T- --$U- --$V+ --$W- --$X+ --$YD --$Z1 --cg --AWinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; --H+ --W+ --M --$M16384,1048576 --K$00400000 --E.\..\..\..\..\ --LNc:\borland\delphi4\Lib diff --git a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dof b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dof deleted file mode 100644 index 66305adc..00000000 --- a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dof +++ /dev/null @@ -1,87 +0,0 @@ -[Compiler] -A=1 -B=0 -C=1 -D=1 -E=0 -F=0 -G=1 -H=1 -I=1 -J=1 -K=0 -L=1 -M=0 -N=1 -O=1 -P=1 -Q=0 -R=0 -S=0 -T=0 -U=0 -V=1 -W=0 -X=1 -Y=1 -Z=1 -ShowHints=1 -ShowWarnings=1 -UnitAliases=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[Linker] -MapFile=0 -OutputObjs=0 -ConsoleApp=1 -DebugInfo=0 -RemoteSymbols=0 -MinStackSize=16384 -MaxStackSize=1048576 -ImageBase=4194304 -ExeDescription= -[Directories] -OutputDir=.\..\..\..\..\ -UnitOutputDir= -PackageDLLOutputDir= -PackageDCPOutputDir= -SearchPath= -Packages=Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40 -Conditionals= -DebugSourceDirs= -UsePackages=0 -[Parameters] -RunParams= -HostApplication= -[Version Info] -IncludeVerInfo=0 -AutoIncBuild=0 -MajorVer=1 -MinorVer=0 -Release=0 -Build=0 -Debug=0 -PreRelease=0 -Special=0 -Private=0 -DLL=0 -Locale=1031 -CodePage=1252 -[Version Info Keys] -CompanyName= -FileDescription= -FileVersion=1.0.0.0 -InternalName= -LegalCopyright= -LegalTrademarks= -OriginalFilename= -ProductName= -ProductVersion=1.0.0.0 -Comments= -[Excluded Packages] -$(DELPHI)\Lib\dclusr40.bpl=Borland User -[HistoryLists\hlUnitAliases] -Count=1 -Item0=WinTypes=Windows;WinProcs=Windows;DbiTypes=BDE;DbiProcs=BDE;DbiErrs=BDE; -[HistoryLists\hlOutputDirectorry] -Count=2 -Item0=.\..\..\..\..\ -Item1=.\..\..\..\ diff --git a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr index 1339f8b8..deb150eb 100644 --- a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr +++ b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dpr @@ -224,7 +224,7 @@ begin end; // update the log - MbiCallbackOnLog(logStr); + MbiCallbackOnLog(ShortString(logStr)); // update loop variables len := len - currentWriteCnt; @@ -258,14 +258,14 @@ begin // connect the transport layer MbiCallbackOnInfo('Connecting to target via USB.'); - MbiCallbackOnLog('Connecting to target via USB. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connecting to target via USB. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; if not loader.Connect then begin // update the user info MbiCallbackOnInfo('Could not connect via USB. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Transport layer connection failed. t='+TimeToStr(Time)); - MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+TimeToStr(Time)); + MbiCallbackOnLog('Transport layer connection failed. t='+ShortString(TimeToStr(Time))); + MbiCallbackOnLog('Retrying transport layer connection. Reset your target if this takes a long time. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // continuously try to coonect the transport layer while not loader.Connect do @@ -281,14 +281,14 @@ begin end; //---------------- start the programming session -------------------------------------- - MbiCallbackOnLog('Starting the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Starting the programming session. t='+ShortString(TimeToStr(Time))); // try initial connect via XCP if loader.StartProgrammingSession <> kProgSessionStarted then begin // update the user info MbiCallbackOnInfo('Could not connect. Retrying. Reset your target if this takes a long time.'); - MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+TimeToStr(Time)); + MbiCallbackOnLog('Connect failed. Switching to backdoor entry mode. t='+ShortString(TimeToStr(Time))); Application.ProcessMessages; // continuously try to connect via XCP true the backdoor sessionStartResult := kProgSessionGenericError; @@ -300,7 +300,7 @@ begin // don't retry if the error was caused by not being able to unprotect the programming resource if sessionStartResult = kProgSessionUnlockError then begin - MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+TimeToStr(Time)); + MbiCallbackOnLog('Security issue. Could not unprotect the programming resource. Check your configured XCP protection DLL. t='+ShortString(TimeToStr(Time))); MbiCallbackOnError('Security issue. Could not unprotect the programming resource.'); Exit; end; @@ -315,7 +315,7 @@ begin end; // still here so programming session was started - MbiCallbackOnLog('Programming session started. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session started. t='+ShortString(TimeToStr(Time))); // create the datafile object datafile := TXcpDataFile.Create(progfile); @@ -340,16 +340,16 @@ begin datafile.GetRegionInfo(regionCnt, addr, len); // erase the memory - MbiCallbackOnLog('Clearing Memory '+Format('addr:0x%x,len:0x%x',[addr,len])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Clearing Memory '+ShortString(Format('addr:0x%x,len:0x%x',[addr,len]))+'. t='+ShortString(TimeToStr(Time))); if not loader.ClearMemory(addr, len) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not clear memory ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not clear memory ('+errorInfo+').'); + MbiCallbackOnLog('Could not clear memory ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not clear memory ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Memory cleared. t='+TimeToStr(Time)); + MbiCallbackOnLog('Memory cleared. t='+ShortString(TimeToStr(Time))); end; //---------------- next program the memory regions ------------------------------------ @@ -373,18 +373,18 @@ begin if currentWriteCnt = 0 then currentWriteCnt := kMaxProgLen; // program the data - MbiCallbackOnLog('Programming Data '+Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt])+'. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming Data '+ShortString(Format('addr:0x%x,len:0x%x',[addr,currentWriteCnt]))+'. t='+ShortString(TimeToStr(Time))); LogData(@progdata[bufferOffset], currentWriteCnt); if not loader.WriteData(addr, currentWriteCnt, @progdata[bufferOffset]) then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not program data ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not program data ('+errorInfo+').'); + MbiCallbackOnLog('Could not program data ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not program data ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Data Programmed. t='+TimeToStr(Time)); + MbiCallbackOnLog('Data Programmed. t='+ShortString(TimeToStr(Time))); // update progress progress := progress + currentWriteCnt; @@ -396,28 +396,28 @@ begin bufferOffset := bufferOffset + currentWriteCnt; // update the user info - MbiCallbackOnInfo('Programming data... ' + Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB])); + MbiCallbackOnInfo('Programming data... ' + ShortString(Format('(%.1n of %.1n Kbytes)',[(progress/1024), dataSizeKB]))); end; end; //---------------- stop the programming session --------------------------------------- - MbiCallbackOnLog('Stopping the programming session. t='+TimeToStr(Time)); + MbiCallbackOnLog('Stopping the programming session. t='+ShortString(TimeToStr(Time))); if not loader.StopProgrammingSession then begin loader.GetLastError(errorInfo); - MbiCallbackOnLog('Could not stop the programming session ('+errorInfo+'). t='+TimeToStr(Time)); - MbiCallbackOnError('Could not stop the programming session ('+errorInfo+').'); + MbiCallbackOnLog('Could not stop the programming session ('+ShortString(errorInfo)+'). t='+ShortString(TimeToStr(Time))); + MbiCallbackOnError('Could not stop the programming session ('+ShortString(errorInfo)+').'); datafile.Free; Exit; end; - MbiCallbackOnLog('Programming session stopped. t='+TimeToStr(Time)); + MbiCallbackOnLog('Programming session stopped. t='+ShortString(TimeToStr(Time))); // all done so set progress to 100% and finish up progress := datafile.GetDataCnt; datafile.Free; MbiCallbackOnProgress(progress); - MbiCallbackOnLog('File successfully downloaded t='+TimeToStr(Time)); + MbiCallbackOnLog('File successfully downloaded t='+ShortString(TimeToStr(Time))); MbiCallbackOnDone; end; //*** end of OnTimeout *** @@ -481,7 +481,7 @@ begin timer.Enabled := True; // store the program's filename - progfile := fileName; + progfile := String(fileName); end; //*** end of MbiStart *** @@ -499,7 +499,7 @@ begin stopRequest := true; // disconnect the transport layer - MbiCallbackOnLog('Disconnecting the transport layer. t='+TimeToStr(Time)); + MbiCallbackOnLog('Disconnecting the transport layer. t='+ShortString(TimeToStr(Time))); loader.Disconnect; end; //*** end of MbiStop *** @@ -618,16 +618,15 @@ end; //*** end of MbiConfigure *** //*************************************************************************************** exports //--- begin of don't change --- - MbiInit index 1, - MbiStart index 2, - MbiStop index 3, - MbiDeInit index 4, - MbiName index 5, - MbiDescription index 6, - MbiVersion index 7, - MbiConfigure index 8, - MbiVInterface index 9; + MbiInit, + MbiStart, + MbiStop, + MbiDeInit, + MbiName, + MbiDescription, + MbiVersion, + MbiConfigure, + MbiVInterface; //--- end of don't change --- - end. //********************************** end of openblt_usb.dpr ***************************** diff --git a/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj new file mode 100644 index 00000000..eaf36b20 --- /dev/null +++ b/Host/Source/MicroBoot/interfaces/usb/openblt_usb.dproj @@ -0,0 +1,120 @@ + + + {5F773EB4-5A4B-4591-999A-E208B1A44407} + openblt_usb.dpr + True + Debug + 1 + Library + VCL + 18.1 + Win32 + + + true + + + true + Base + true + + + true + Base + true + + + true + Base + true + + + true + Cfg_2 + true + true + + + false + false + 1 + true + .\..\..\..\..\ + 1 + true + false + false + 00400000 + true + Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;$(DCC_Namespace) + openblt_usb + 1031 + 1 + CompanyName=;FileDescription=;FileVersion=1.0.0.0;InternalName=;LegalCopyright=;LegalTrademarks=;OriginalFilename=;ProductName=;ProductVersion=1.0.0.0;Comments= + Vcl40;Vclx40;Vcldb40;vcldbx40;VclSmp40;Qrpt40;$(DCC_UsePackage) + + + 1033 + System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;$(DCC_Namespace) + true + + + RELEASE;$(DCC_Define) + false + 0 + 0 + + + true + DEBUG;$(DCC_Define) + false + + + C:\Work\software\OpenBLT\Host\MicroBoot.exe + 1033 + (None) + true + + + + MainSource + + + + + + + +
XcpSettingsForm
+ + + + Cfg_2 + Base + + + Base + + + Cfg_1 + Base + + + + Delphi.Personality.12 + + + + + openblt_usb.dpr + + + + True + + + 12 + + + + diff --git a/Host/Source/MicroBoot/uBootInterface.pas b/Host/Source/MicroBoot/uBootInterface.pas index 810eba14..92856138 100644 --- a/Host/Source/MicroBoot/uBootInterface.pas +++ b/Host/Source/MicroBoot/uBootInterface.pas @@ -148,7 +148,7 @@ end; //*** end of Create *** //*************************************************************************************** destructor TMicroBootInterface.Destroy; begin - if FLibraryHandle = 0 then //##Vg shouldn't this be <> 0? + if FLibraryHandle <> 0 then begin FreeLibrary(FLibraryHandle); // release the handle end; diff --git a/Host/openblt_can_peak.dll b/Host/openblt_can_peak.dll index fc39d61e..d73863ad 100644 Binary files a/Host/openblt_can_peak.dll and b/Host/openblt_can_peak.dll differ diff --git a/Host/openblt_can_peak.ini b/Host/openblt_can_peak.ini index 98acacfa..a0c9bdec 100644 --- a/Host/openblt_can_peak.ini +++ b/Host/openblt_can_peak.ini @@ -1,7 +1,7 @@ [can] hardware=0 channel=0 -baudrate=500 +baudrate=2 extended=0 txid=1639 rxid=2017 diff --git a/Host/openblt_can_vector.dll b/Host/openblt_can_vector.dll deleted file mode 100644 index 10688c4d..00000000 Binary files a/Host/openblt_can_vector.dll and /dev/null differ diff --git a/Host/openblt_can_vector.ini b/Host/openblt_can_vector.ini deleted file mode 100644 index 571a73bb..00000000 --- a/Host/openblt_can_vector.ini +++ /dev/null @@ -1,15 +0,0 @@ -[can] -hardware=2 -channel=0 -baudrate=500 -extended=0 -txid=1639 -rxid=2017 -[xcp] -seedkey=FeaserKey.dll -t1=1000 -t3=2000 -t4=10000 -t5=1000 -t7=2000 -tconnect=20 diff --git a/Host/openblt_net.dll b/Host/openblt_net.dll index 8936b1bc..918ad048 100644 Binary files a/Host/openblt_net.dll and b/Host/openblt_net.dll differ diff --git a/Host/openblt_net.ini b/Host/openblt_net.ini index d659c657..9e2d8189 100644 --- a/Host/openblt_net.ini +++ b/Host/openblt_net.ini @@ -1,7 +1,6 @@ [net] -hostname=169.254.19.63 +hostname=192.168.178.38 port=1000 -retry=1 [xcp] seedkey=FeaserKey.dll t1=1000 diff --git a/Host/openblt_uart.dll b/Host/openblt_uart.dll index 2f990392..77ac705c 100644 Binary files a/Host/openblt_uart.dll and b/Host/openblt_uart.dll differ diff --git a/Host/openblt_uart.ini b/Host/openblt_uart.ini index 34d42005..922a4fe5 100644 --- a/Host/openblt_uart.ini +++ b/Host/openblt_uart.ini @@ -1,5 +1,5 @@ [sci] -port=2 +port=7 baudrate=8 [xcp] seedkey=FeaserKey.dll diff --git a/Host/openblt_usb.dll b/Host/openblt_usb.dll index a1116cfe..d8cf1002 100644 Binary files a/Host/openblt_usb.dll and b/Host/openblt_usb.dll differ diff --git a/Host/vcand32.dll b/Host/vcand32.dll deleted file mode 100644 index 56dcfe98..00000000 Binary files a/Host/vcand32.dll and /dev/null differ