pascal/synapse
1
0
Fork 0
Code Issues Releases Activity

synaser.pas - fixed compiler defines for WIN64 support

Browse Source 
git-svn-id: https://svn.code.sf.net/p/synalist/code/trunk@119 7c85be65-684b-0410-a082-b2ed4fbef004
This commit is contained in:
geby
2010-01-27 21:37:13 +00:00
parent 6f399a9260
commit 7c3b22b616
1 changed files with 47 additions and 40 deletions
Download Patch File Download Diff File Expand all files Collapse all files

87
synaser.pas
View File

@@ -1,9 +1,9 @@
{==============================================================================| {==============================================================================|
| Project : Ararat Synapse | 007.003.000 | | Project : Ararat Synapse | 007.004.000 |
|==============================================================================| |==============================================================================|
| Content: Serial port support | | Content: Serial port support |
|==============================================================================| |==============================================================================|
| Copyright (c)2001-2008, Lukas Gebauer | | Copyright (c)2001-2010, Lukas Gebauer |
| All rights reserved. | | All rights reserved. |
| | | |
| Redistribution and use in source and binary forms, with or without | | Redistribution and use in source and binary forms, with or without |
@@ -33,7 +33,7 @@
| DAMAGE. | | DAMAGE. |
|==============================================================================| |==============================================================================|
| The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).| | The Initial Developer of the Original Code is Lukas Gebauer (Czech Republic).|
| Portions created by Lukas Gebauer are Copyright (c)2001-2008. | | Portions created by Lukas Gebauer are Copyright (c)2001-2010. |
| All Rights Reserved. | | All Rights Reserved. |
|==============================================================================| |==============================================================================|
| Contributor(s): | | Contributor(s): |
@@ -69,9 +69,16 @@ case with my USB modem):
#) #)
} }
//old Delphi does not have MSWINDOWS define.
{$IFDEF WIN32}
{$IFNDEF MSWINDOWS}
{$DEFINE MSWINDOWS}
{$ENDIF}
{$ENDIF}
{$IFDEF FPC} {$IFDEF FPC}
{$MODE DELPHI} {$MODE DELPHI}
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
{$ASMMODE intel} {$ASMMODE intel}
{$ENDIF} {$ENDIF}
{define working mode w/o LIBC for fpc} {define working mode w/o LIBC for fpc}
@@ -86,7 +93,7 @@ unit synaser;
interface interface
uses uses
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
{$IFNDEF NO_LIBC} {$IFNDEF NO_LIBC}
Libc, Libc,
KernelIoctl, KernelIoctl,
@@ -156,7 +163,7 @@ const
{:stopbit value for 2 stopbits} {:stopbit value for 2 stopbits}
SB2 = 2; SB2 = 2;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
const const
INVALID_HANDLE_VALUE = THandle(-1); INVALID_HANDLE_VALUE = THandle(-1);
CS7fix = $0000020; CS7fix = $0000020;
@@ -280,7 +287,7 @@ type
FAtTimeout: integer; FAtTimeout: integer;
FInterPacketTimeout: Boolean; FInterPacketTimeout: Boolean;
FComNr: integer; FComNr: integer;
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
FPortAddr: Word; FPortAddr: Word;
function CanEvent(Event: dword; Timeout: integer): boolean; function CanEvent(Event: dword; Timeout: integer): boolean;
procedure DecodeCommError(Error: DWord); virtual; procedure DecodeCommError(Error: DWord); virtual;
@@ -298,7 +305,7 @@ type
procedure GetComNr(Value: string); virtual; procedure GetComNr(Value: string); virtual;
function PreTestFailing: boolean; virtual;{HGJ} function PreTestFailing: boolean; virtual;{HGJ}
function TestCtrlLine: Boolean; virtual; function TestCtrlLine: Boolean; virtual;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual; procedure DcbToTermios(const dcb: TDCB; var term: termios); virtual;
procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual; procedure TermiosToDcb(const term: termios; var dcb: TDCB); virtual;
{$ENDIF} {$ENDIF}
@@ -313,7 +320,7 @@ type
{: data Control Block with communication parameters. Usable only when you {: data Control Block with communication parameters. Usable only when you
need to call API directly.} need to call API directly.}
DCB: Tdcb; DCB: Tdcb;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
TermiosStruc: termios; TermiosStruc: termios;
{$ENDIF} {$ENDIF}
{:Object constructor.} {:Object constructor.}
@@ -778,7 +785,7 @@ begin
DoStatus(HR_SerialClose, FDevice); DoStatus(HR_SerialClose, FDevice);
end; end;
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
function TBlockSerial.GetPortAddr: Word; function TBlockSerial.GetPortAddr: Word;
begin begin
Result := 0; Result := 0;
@@ -878,7 +885,7 @@ begin
end; end;
procedure TBlockSerial.Connect(comport: string); procedure TBlockSerial.Connect(comport: string);
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
var var
CommTimeouts: TCommTimeouts; CommTimeouts: TCommTimeouts;
{$ENDIF} {$ENDIF}
@@ -892,7 +899,7 @@ begin
FBuffer := ''; FBuffer := '';
FDevice := comport; FDevice := comport;
GetComNr(comport); GetComNr(comport);
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
SetLastError (sOK); SetLastError (sOK);
{$ELSE} {$ELSE}
{$IFNDEF FPC} {$IFNDEF FPC}
@@ -901,7 +908,7 @@ begin
fpSetErrno(sOK); fpSetErrno(sOK);
{$ENDIF} {$ENDIF}
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
if FComNr <> PortIsClosed then if FComNr <> PortIsClosed then
FDevice := '/dev/ttyS' + IntToStr(FComNr); FDevice := '/dev/ttyS' + IntToStr(FComNr);
// Comport already owned by another process? {HGJ} // Comport already owned by another process? {HGJ}
@@ -968,7 +975,7 @@ begin
end; end;
function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer; function TBlockSerial.SendBuffer(buffer: pointer; length: integer): integer;
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
var var
Overlapped: TOverlapped; Overlapped: TOverlapped;
x, y, Err: DWord; x, y, Err: DWord;
@@ -983,7 +990,7 @@ begin
Flush; Flush;
RTS := True; RTS := True;
end; end;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
result := FileWrite(integer(Fhandle), Buffer^, Length); result := FileWrite(integer(Fhandle), Buffer^, Length);
serialcheck(result); serialcheck(result);
{$ELSE} {$ELSE}
@@ -1085,7 +1092,7 @@ begin
end; end;
function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer; function TBlockSerial.RecvBuffer(buffer: pointer; length: integer): integer;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
begin begin
Result := 0; Result := 0;
if PreTestFailing then {HGJ} if PreTestFailing then {HGJ}
@@ -1407,7 +1414,7 @@ begin
RecvStreamSize(Stream, Timeout, x); RecvStreamSize(Stream, Timeout, x);
end; end;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
function TBlockSerial.WaitingData: integer; function TBlockSerial.WaitingData: integer;
begin begin
{$IFNDEF FPC} {$IFNDEF FPC}
@@ -1447,7 +1454,7 @@ begin
Result := Waitingdata; Result := Waitingdata;
end; end;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
function TBlockSerial.SendingData: integer; function TBlockSerial.SendingData: integer;
begin begin
SetSynaError(sOK); SetSynaError(sOK);
@@ -1467,7 +1474,7 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios); procedure TBlockSerial.DcbToTermios(const dcb: TDCB; var term: termios);
var var
n: integer; n: integer;
@@ -1590,7 +1597,7 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
procedure TBlockSerial.SetCommState; procedure TBlockSerial.SetCommState;
begin begin
DcbToTermios(dcb, termiosstruc); DcbToTermios(dcb, termiosstruc);
@@ -1607,7 +1614,7 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
procedure TBlockSerial.GetCommState; procedure TBlockSerial.GetCommState;
begin begin
SerialCheck(tcgetattr(integer(FHandle), termiosstruc)); SerialCheck(tcgetattr(integer(FHandle), termiosstruc));
@@ -1626,7 +1633,7 @@ end;
procedure TBlockSerial.SetSizeRecvBuffer(size: integer); procedure TBlockSerial.SetSizeRecvBuffer(size: integer);
begin begin
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
SetupComm(Fhandle, size, 0); SetupComm(Fhandle, size, 0);
GetCommState; GetCommState;
dcb.XonLim := size div 4; dcb.XonLim := size div 4;
@@ -1639,7 +1646,7 @@ end;
function TBlockSerial.GetDSR: Boolean; function TBlockSerial.GetDSR: Boolean;
begin begin
ModemStatus; ModemStatus;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
Result := (FModemWord and TIOCM_DSR) > 0; Result := (FModemWord and TIOCM_DSR) > 0;
{$ELSE} {$ELSE}
Result := (FModemWord and MS_DSR_ON) > 0; Result := (FModemWord and MS_DSR_ON) > 0;
@@ -1648,7 +1655,7 @@ end;
procedure TBlockSerial.SetDTRF(Value: Boolean); procedure TBlockSerial.SetDTRF(Value: Boolean);
begin begin
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
ModemStatus; ModemStatus;
if Value then if Value then
FModemWord := FModemWord or TIOCM_DTR FModemWord := FModemWord or TIOCM_DTR
@@ -1670,7 +1677,7 @@ end;
function TBlockSerial.GetCTS: Boolean; function TBlockSerial.GetCTS: Boolean;
begin begin
ModemStatus; ModemStatus;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
Result := (FModemWord and TIOCM_CTS) > 0; Result := (FModemWord and TIOCM_CTS) > 0;
{$ELSE} {$ELSE}
Result := (FModemWord and MS_CTS_ON) > 0; Result := (FModemWord and MS_CTS_ON) > 0;
@@ -1679,7 +1686,7 @@ end;
procedure TBlockSerial.SetRTSF(Value: Boolean); procedure TBlockSerial.SetRTSF(Value: Boolean);
begin begin
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
ModemStatus; ModemStatus;
if Value then if Value then
FModemWord := FModemWord or TIOCM_RTS FModemWord := FModemWord or TIOCM_RTS
@@ -1701,7 +1708,7 @@ end;
function TBlockSerial.GetCarrier: Boolean; function TBlockSerial.GetCarrier: Boolean;
begin begin
ModemStatus; ModemStatus;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
Result := (FModemWord and TIOCM_CAR) > 0; Result := (FModemWord and TIOCM_CAR) > 0;
{$ELSE} {$ELSE}
Result := (FModemWord and MS_RLSD_ON) > 0; Result := (FModemWord and MS_RLSD_ON) > 0;
@@ -1711,14 +1718,14 @@ end;
function TBlockSerial.GetRing: Boolean; function TBlockSerial.GetRing: Boolean;
begin begin
ModemStatus; ModemStatus;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
Result := (FModemWord and TIOCM_RNG) > 0; Result := (FModemWord and TIOCM_RNG) > 0;
{$ELSE} {$ELSE}
Result := (FModemWord and MS_RING_ON) > 0; Result := (FModemWord and MS_RING_ON) > 0;
{$ENDIF} {$ENDIF}
end; end;
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean; function TBlockSerial.CanEvent(Event: dword; Timeout: integer): boolean;
var var
ex: DWord; ex: DWord;
@@ -1753,7 +1760,7 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
function TBlockSerial.CanRead(Timeout: integer): boolean; function TBlockSerial.CanRead(Timeout: integer): boolean;
var var
FDSet: TFDSet; FDSet: TFDSet;
@@ -1794,7 +1801,7 @@ begin
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
function TBlockSerial.CanWrite(Timeout: integer): boolean; function TBlockSerial.CanWrite(Timeout: integer): boolean;
var var
FDSet: TFDSet; FDSet: TFDSet;
@@ -1858,7 +1865,7 @@ end;
procedure TBlockSerial.EnableRTSToggle(Value: boolean); procedure TBlockSerial.EnableRTSToggle(Value: boolean);
begin begin
SetSynaError(sOK); SetSynaError(sOK);
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
FRTSToggle := Value; FRTSToggle := Value;
if Value then if Value then
RTS:=False; RTS:=False;
@@ -1883,7 +1890,7 @@ end;
procedure TBlockSerial.Flush; procedure TBlockSerial.Flush;
begin begin
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
SerialCheck(tcdrain(integer(FHandle))); SerialCheck(tcdrain(integer(FHandle)));
{$ELSE} {$ELSE}
SetSynaError(sOK); SetSynaError(sOK);
@@ -1893,7 +1900,7 @@ begin
ExceptCheck; ExceptCheck;
end; end;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
procedure TBlockSerial.Purge; procedure TBlockSerial.Purge;
begin begin
{$IFNDEF FPC} {$IFNDEF FPC}
@@ -1921,7 +1928,7 @@ end;
function TBlockSerial.ModemStatus: integer; function TBlockSerial.ModemStatus: integer;
begin begin
Result := 0; Result := 0;
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
{$IFNDEF FPC} {$IFNDEF FPC}
SerialCheck(ioctl(integer(FHandle), TIOCMGET, @Result)); SerialCheck(ioctl(integer(FHandle), TIOCMGET, @Result));
{$ELSE} {$ELSE}
@@ -1938,7 +1945,7 @@ end;
procedure TBlockSerial.SetBreak(Duration: integer); procedure TBlockSerial.SetBreak(Duration: integer);
begin begin
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
SerialCheck(tcsendbreak(integer(FHandle), Duration)); SerialCheck(tcsendbreak(integer(FHandle), Duration));
{$ELSE} {$ELSE}
SetCommBreak(FHandle); SetCommBreak(FHandle);
@@ -1949,7 +1956,7 @@ begin
{$ENDIF} {$ENDIF}
end; end;
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
procedure TBlockSerial.DecodeCommError(Error: DWord); procedure TBlockSerial.DecodeCommError(Error: DWord);
begin begin
if (Error and DWord(CE_FRAME)) > 1 then if (Error and DWord(CE_FRAME)) > 1 then
@@ -2050,7 +2057,7 @@ end;
function TBlockSerial.SerialCheck(SerialResult: integer): integer; function TBlockSerial.SerialCheck(SerialResult: integer): integer;
begin begin
if SerialResult = integer(INVALID_HANDLE_VALUE) then if SerialResult = integer(INVALID_HANDLE_VALUE) then
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
result := GetLastError result := GetLastError
{$ELSE} {$ELSE}
{$IFNDEF FPC} {$IFNDEF FPC}
@@ -2236,7 +2243,7 @@ end;
{$ENDIF} {$ENDIF}
{----------------------------------------------------------------} {----------------------------------------------------------------}
{$IFDEF WIN32} {$IFDEF MSWINDOWS}
function GetSerialPortNames: string; function GetSerialPortNames: string;
var var
reg: TRegistry; reg: TRegistry;
@@ -2265,7 +2272,7 @@ begin
end; end;
end; end;
{$ENDIF} {$ENDIF}
{$IFNDEF WIN32} {$IFNDEF MSWINDOWS}
function GetSerialPortNames: string; function GetSerialPortNames: string;
var var
Index: Integer; Index: Integer;