How can I access LPT / COM ports just using source codes in Delphi?

Question

A Delphi source code which would work in win98:
asm
mov dx, 0378h
mov al, 05h
out dx, al
end;
It can be inside a procedure:
procedure SendDataToPort(PortNo: Word; PortDataByte: Byte);
begin
asm
mov dx, PortNo
mov al, PortDataByte
out dx, al
end;
end;
There are lots of ways to access ports in Win NT/2000/XP/Vista/7 you know,
But for all of them (as I have researched) you should buy and/or download a file such as ntport.dll, portio.sys, ... then link it to your app to be able to switch to kernel mode then talk with ports and then back in user mode.
My question is: How can I access ports just using source codes as simple as in win98?
I need a unit or some functions (with their source codes) to talk with any port I want.
Mybe a source code of the above files could help me.

Answer 1

Hey Maz,



The answer is to use streams to open/read/write to device ports defined under Windows (for both COMn and LPTn). I'll be happy to send you some source if you mail me at [e-mail]. Answers is not good for code share.



na



-----

unit uSerial;



interface



uses

//native

Windows, SysUtils, Classes, Registry,

//in-house

uObjects, uCommon, uScript;



type



////////////////////////////////////////////////////////////////////////////////

// class TSerialComms - basic comms encapsulation class

TBeforeDataWrite = procedure (ComID: integer; data: string) of object;

TAfterDataWrite = procedure (ComID: integer; data: string) of object;

TBeforeDataRead = procedure (ComID: integer; data: string) of object;

TAfterDataRead = procedure (ComID: integer; data: string) of object;



TSerial = class(TEObject)

private

//private fields

fValidPorts: TStrings; //Internal list of valid com ports

lpDCB: TDCB; //com port settings Device Control Block (DCB)

lpTimeouts: TCommTimeouts; //com port timeouts

fhCOM: THandle; //com port handle

fPortOpen: boolean; //boolean com port open flag

fCOMPort: byte; //COM port number 0-n

//private custom events

fBeforeDataWrite: TBeforeDataWrite;

fAfterDataWrite: TAfterDataWrite;

fBeforeDataRead: TBeforeDataRead;

fAfterDataRead: TAfterDataRead;

//private methods

function GetBaud: integer;

function GetBSize: byte;

function GetEofChar: char;

function GetErrorChar: char;

function GetEvtChar: char;

function GetParity: Integer;

function GetStopBits: integer;

function GetXoffChar: char;

function GetXoffLim: Word;

function GetXonChar: char;

function GetXonLim: Word;

procedure SetBaud(const Value: integer);

procedure SetBSize(const Value: byte);

procedure SetEofChar(const Value: char);

procedure SetErrorChar(const Value: char);

procedure SetEvtChar(const Value: char);

procedure SetParity(const Value: Integer);

procedure SetStopBits(const Value: integer);

procedure SetXoffChar(const Value: char);

procedure SetXoffLim(const Value: Word);

procedure SetXonChar(const Value: char);

procedure SetXonLim(const Value: Word);

function GetIntervalTimeout: cardinal;

function GetTotalTimeoutConstant: cardinal;

function GetTotalTimeoutMultiplier: cardinal;

procedure SetIntervalTimeout(const Value: cardinal);

procedure SetTotalTimeoutConstant(const Value: cardinal);

procedure SetTotalTimeoutMultiplier(const Value: cardinal);

public

constructor Create(PortID: Integer=0);

destructor Destroy; override;

function PortExists(ComID: integer): boolean; overload;

function PortExists: boolean; overload;

function PortRead(out Size: integer; out Success: boolean): TByteArray;

function PortWrite(data: TByteArray; Size: integer): boolean;

procedure PortReset;

function PortOpen: boolean;

procedure PortClose;

published

property COMID: byte read fCOMPort write fCOMPort;

property IsOpen: boolean read fPortOpen;

//properties to expose DCB settings (_DCB is record, so direct access is denied)

property BaudRate: integer read GetBaud write SetBaud;

property ByteSize: byte read GetBSize write SetBSize;

property Parity: Integer read GetParity write SetParity;

property StopBits: integer read GetStopBits write SetStopBits;

property XonLim: Word read GetXonLim write SetXonLim;

property XoffLim: Word read GetXoffLim write SetXoffLim;

property XonChar: char read GetXonChar write SetXonChar;

property XoffChar: char read GetXoffChar write SetXoffChar;

property ErrorChar: char read GetErrorChar write SetErrorChar;

property EofChar: char read GetEofChar write SetEofChar;

property EvtChar: char read GetEvtChar write SetEvtChar;

property IntervalTimeout: cardinal read GetIntervalTimeout write SetIntervalTimeout;

property TotalTimeoutMultiplier: cardinal read GetTotalTimeoutMultiplier write SetTotalTimeoutMultiplier;

property TotalTimeoutConstant: cardinal read GetTotalTimeoutConstant write SetTotalTimeoutConstant;

//custom events

property BeforeDataWrite: TBeforeDataWrite read fBeforeDataWrite write fBeforeDataWrite;

property AfterDataWrite: TAfterDataWrite read fAfterDataWrite write fAfterDataWrite;

property BeforeDataRead: TBeforeDataRead read fBeforeDataRead write fBeforeDataRead;

property AfterDataRead: TAfterDataRead read fAfterDataRead write fAfterDataRead;

end; {class TSerial}



//useful helper function(s)

procedure GetAvailCOMPorts(out ComPorts: TStrings);



implementation



procedure GetAvailCOMPorts(out ComPorts: TStrings);

var reg: TRegistry;

v: shortstring;

i: byte;

begin

//return a list of available COM ports for local machine

if ComPorts<>nil then

try

ComPorts.Clear;

reg:=TRegistry.Create;

reg.RootKey:=HKEY_LOCAL_MACHINE;

if reg.KeyExists('HARDWARE\DEVICEMAP\SERIALCOMM') then

begin

reg.OpenKey('HARDWARE\DEVICEMAP\SERIALCOMM', false);

i:=0;

v:='\Device\Serial'+IntToStr(i);

while reg.ValueExists(v) do

begin

ComPorts.Add(reg.ReadString(v));

inc(i);

v:='\Device\Serial'+IntToStr(i);

end; //while

end; //if

except

on e: exception do

raise(e);

end; //try

end; {GetAvailCOMPorts}







////////////////////////////////////////////////////////////////////////////////

{ TSerialComms }



constructor TSerial.Create(PortID: integer);

begin

inherited Create;

//default constructor

fValidPorts:=TStringList.Create;

GetAvailCOMPorts(fValidPorts);

//initialise timeouts

// GetMem(lpTimeoutBuffer, sizeof(COMMTIMEOUTS));

lpTimeouts.ReadIntervalTimeout := 1000; //value in milliseconds

lpTimeOuts.ReadTotalTimeoutMultiplier := 3; //?

lpTimeOuts.ReadTotalTimeoutConstant := 1; //?

lpTimeOuts.WriteTotalTimeoutMultiplier := 3; //?

lpTimeOuts.WriteTotalTimeoutConstant := 1; //?

//initialise DCB settings

lpDCB.DCBlength := SizeOf(TDCB);

lpDCB.BaudRate := CBR_19200;

lpDCB.Flags := 12305;

lpDCB.wReserved := 0;

lpDCB.XonLim := 600;

lpDCB.XoffLim := 150;

lpDCB.ByteSize := 8;

lpDCB.Parity := ODDPARITY;

lpDCB.StopBits := ONESTOPBIT;

lpDCB.XonChar:=#17;

lpDCB.XoffChar:=#19;

lpDCB.ErrorChar:=#0;

lpDCB.EofChar:=#0;

lpDCB.EvtChar:=#0;

lpDCB.wReserved1:=65;

//initialise object fields

fCOMPort := PortID;

fPortOpen := false;

//initialise custom event method pointers

fBeforeDataRead:=nil;

fAfterDataRead:=nil;

fBeforeDataWrite:=nil;

fAfterDataWrite:=nil;

end; {create}



destructor TSerial.Destroy;

begin

//default destructor

PortClose; //ensure port closed

FreeAndNil(fValidPorts);

inherited;

end; {destroy}



...



end.

Answer 2

I agree entirely with your views ! The most infuriating are those that give a wrong answer and then back it up with an online translator as a source. Besides trying to accumulate points, other elements come into play, such as getting an answer in first with a chance it will be chosen immediately, or trying to find an answer faster than anyone else irrespective of one's lack of knowledge. It is playing on the asker's naivety (who cannot determine which answer is the correct one), but sometimes there is a genuine desire to be helpful on the assumption that the asker may not be able to get any answer at all. The sad thing is that, as has been pointed out earlier, the answer given by translating sites is frequently incorrect or misleading, and the person who gets it has not got the wherewithal to pick a correct answer, or the grammatical background to use the information provided. What is really disappointing is to see a rubbishy answer picked rather than the accurate answers provided by genuinely knowledgeable people, or educated native speakers who really know what they are tackling. Although, to be fair, there are often experts , or "know all" natives who do make mistakes too. When I look at the profile of some native contributors, the spelling and grammar in their own tongue is often horrific, and the same people give advice (which is hardly better than a universal translator) on the English speaking site on the strength of their nationality. In any case some people chose the answer that they like best because they like an avatar, or because they prefer to deal with their peers rather than teachers, "top contributors" or "foggies". As you rightly say Yahoo is not an ideal forum, and the language questions have become rather trivial of late. Add to that the thumbs down given to answers in foreign languages, and French in particular simply because France is in the doghouse at the moment...So one's contributions become pretty pointless.

Answer 3

http://www.scienceprog.com/control-lpt-port-under-windows-xp-using-delphi/