AI_Slop/WinComm
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Compare commits

base: AI_Slop:dd8326d16a0df068fd8dad9b84cf868b6ffce486
Branches Tags
AI_Slop:master
..
compare: AI_Slop:4218da32eb27119c81330942a6ca20f1f9cd6932
Branches Tags
AI_Slop:master

No commits in common. "dd8326d16a0df068fd8dad9b84cf868b6ffce486" and "4218da32eb27119c81330942a6ca20f1f9cd6932" have entirely different histories.
dd8326d16a ... 4218da32eb

10 changed files with 77 additions and 1086 deletions
Show stats Expand all files Collapse all files

734
delphi/KPCOMM.PAS
View file

@ -1,734 +0,0 @@
unit KPComm;
{ KPComm - Native Delphi 1.0 serial communications component. }
{ }
{ TKPComm is a non-visual TComponent descendant providing RS-232 serial }
{ I/O via the Windows 3.1 comm API. Installs to the "KP" palette tab. }
{ }
{ Port lifecycle: OpenComm -> BuildCommDCB + SetCommState -> }
{ EnableCommNotification -> CloseComm. }
{ }
{ WM_COMMNOTIFY messages are received through a hidden utility window }
{ with a registered class and dispatched to ProcessReceiveNotify, }
{ ProcessTransmitNotify, and ProcessEventNotify. }
{ }
{ Modem line status (CTS/DSR/CD) is tracked via shadow booleans toggled }
{ on transition events from GetCommEventMask, since the 16-bit comm API }
{ only provides transition events, not absolute line levels. }
interface
uses
SysUtils, Classes, WinTypes, WinProcs, Messages;
const
{ Communication events }
comEvReceive = 1;
comEvSend = 2;
comEvCTS = 3;
comEvDSR = 4;
comEvCD = 5;
comEvRing = 6;
comEvEOF = 7;
{ Error events }
comEvtBreak = 1001;
comEvtFrame = 1004;
comEvtOverrun = 1006;
comEvtRxOver = 1008;
comEvtParity = 1009;
comEvtTxFull = 1010;
type
THandshaking = (hsNone, hsXonXoff, hsRtsCts, hsBoth);
TInputMode = (imText, imBinary);
TKPComm = class(TComponent)
private
FCommId: Integer;
FHWndNotify: HWnd;
FCommPort: Integer;
FSettings: string;
FPortOpen: Boolean;
FInBufferSize: Integer;
FOutBufferSize: Integer;
FRThreshold: Integer;
FSThreshold: Integer;
FHandshaking: THandshaking;
FInputLen: Integer;
FInputMode: TInputMode;
FDTREnable: Boolean;
FRTSEnable: Boolean;
FNullDiscard: Boolean;
FEOFEnable: Boolean;
FParityReplace: string;
FBreakState: Boolean;
FCommEvent: Integer;
FCTSState: Boolean;
FDSRState: Boolean;
FCDState: Boolean;
FOnComm: TNotifyEvent;
procedure ApplyHandshaking;
procedure ApplyOptions;
procedure ClosePort;
procedure DoCommEvent(EventCode: Integer);
function GetInBufferCount: Integer;
function GetInput: string;
function GetOutBufferCount: Integer;
procedure OpenPort;
procedure ProcessEventNotify;
procedure ProcessReceiveNotify;
procedure ProcessTransmitNotify;
procedure SetBreak(Value: Boolean);
procedure SetCommPort(Value: Integer);
procedure SetDTREnable(Value: Boolean);
procedure SetHandshaking(Value: THandshaking);
procedure SetInBufferSize(Value: Integer);
procedure SetNullDiscard(Value: Boolean);
procedure SetOutBufferSize(Value: Integer);
procedure SetOutput(const Value: string);
procedure SetParityReplace(const Value: string);
procedure SetPortOpen(Value: Boolean);
procedure SetRTSEnable(Value: Boolean);
procedure SetSettings(const Value: string);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
property Input: string read GetInput;
property Output: string write SetOutput;
property InBufferCount: Integer read GetInBufferCount;
property OutBufferCount: Integer read GetOutBufferCount;
property CDHolding: Boolean read FCDState;
property CTSHolding: Boolean read FCTSState;
property DSRHolding: Boolean read FDSRState;
property Break: Boolean read FBreakState write SetBreak;
property CommEvent: Integer read FCommEvent;
published
property CommPort: Integer read FCommPort write SetCommPort default 1;
property Settings: string read FSettings write SetSettings;
property PortOpen: Boolean read FPortOpen write SetPortOpen default False;
property InBufferSize: Integer read FInBufferSize write SetInBufferSize default 4096;
property OutBufferSize: Integer read FOutBufferSize write SetOutBufferSize default 4096;
property RThreshold: Integer read FRThreshold write FRThreshold default 0;
property SThreshold: Integer read FSThreshold write FSThreshold default 0;
property Handshaking: THandshaking read FHandshaking write SetHandshaking default hsNone;
property InputLen: Integer read FInputLen write FInputLen default 0;
property InputMode: TInputMode read FInputMode write FInputMode default imText;
property DTREnable: Boolean read FDTREnable write SetDTREnable default True;
property RTSEnable: Boolean read FRTSEnable write SetRTSEnable default True;
property NullDiscard: Boolean read FNullDiscard write SetNullDiscard default False;
property EOFEnable: Boolean read FEOFEnable write FEOFEnable default False;
property ParityReplace: string read FParityReplace write SetParityReplace;
property OnComm: TNotifyEvent read FOnComm write FOnComm;
end;
procedure Register;
implementation
const
{ WM_COMMNOTIFY notification codes }
CN_RECEIVE = $0001;
CN_TRANSMIT = $0002;
CN_EVENT = $0004;
{ DCB Flags field bit masks. The Windows 3.1 DCB packs thirteen 1-bit }
{ fields into a single UINT (Word) at offset 12 of the structure. }
{ Delphi 1.0 maps this UINT to TDCB.Flags. }
dcbBinary = $0001;
dcbRtsDisable = $0002;
dcbParity = $0004;
dcbOutxCtsFlow = $0008;
dcbOutxDsrFlow = $0010;
dcbDtrDisable = $0020;
dcbOutX = $0040;
dcbInX = $0080;
dcbPeChar = $0100;
dcbNull = $0200;
dcbChEvt = $0400;
dcbDtrflow = $0800;
dcbRtsflow = $1000;
{ Hidden notification window class name }
NotifyClassName = 'KPCommNotify';
var
NotifyClassRegistered: Boolean;
{ ----------------------------------------------------------------------- }
{ Hidden notification window procedure }
{ }
{ Receives WM_COMMNOTIFY from the comm driver. Retrieves the TKPComm }
{ instance pointer stored in the window's extra bytes (offset 0) and }
{ dispatches to the appropriate Process* method. }
{ ----------------------------------------------------------------------- }
function NotifyWndProc(Wnd: HWnd; Msg: Word;
WParam: Word; LParam: Longint): Longint; export;
var
Comm: TKPComm;
NotifyCode: Word;
begin
if Msg = wm_CommNotify then
begin
Comm := TKPComm(GetWindowLong(Wnd, 0));
if (Comm <> nil) and Comm.FPortOpen and (Comm.FCommId >= 0) then
begin
NotifyCode := Word(LParam);
if (NotifyCode and CN_RECEIVE) <> 0 then
Comm.ProcessReceiveNotify;
if (NotifyCode and CN_TRANSMIT) <> 0 then
Comm.ProcessTransmitNotify;
if (NotifyCode and CN_EVENT) <> 0 then
Comm.ProcessEventNotify;
end;
Result := 0;
end
else
Result := DefWindowProc(Wnd, Msg, WParam, LParam);
end;
{ ----------------------------------------------------------------------- }
{ TKPComm }
{ ----------------------------------------------------------------------- }
procedure TKPComm.ApplyHandshaking;
var
DCB: TDCB;
begin
if GetCommState(FCommId, DCB) <> 0 then
Exit;
{ Clear all flow control flags }
DCB.Flags := DCB.Flags and
not (dcbOutxCtsFlow or dcbOutxDsrFlow or dcbOutX or dcbInX or
dcbRtsDisable or dcbRtsflow);
case FHandshaking of
hsXonXoff:
begin
DCB.Flags := DCB.Flags or dcbOutX or dcbInX;
DCB.XonChar := #$11;
DCB.XoffChar := #$13;
DCB.XonLim := 256;
DCB.XoffLim := 256;
end;
hsRtsCts:
begin
DCB.Flags := DCB.Flags or dcbOutxCtsFlow or dcbRtsflow;
end;
hsBoth:
begin
DCB.Flags := DCB.Flags or dcbOutxCtsFlow or dcbRtsflow or
dcbOutX or dcbInX;
DCB.XonChar := #$11;
DCB.XoffChar := #$13;
DCB.XonLim := 256;
DCB.XoffLim := 256;
end;
end;
DCB.Id := FCommId;
SetCommState(DCB);
end;
procedure TKPComm.ApplyOptions;
var
DCB: TDCB;
begin
if GetCommState(FCommId, DCB) <> 0 then
Exit;
if FNullDiscard then
DCB.Flags := DCB.Flags or dcbNull
else
DCB.Flags := DCB.Flags and not dcbNull;
if Length(FParityReplace) > 0 then
begin
DCB.Flags := DCB.Flags or dcbParity;
DCB.PeChar := FParityReplace[1];
end
else
begin
DCB.Flags := DCB.Flags and not dcbParity;
DCB.PeChar := #0;
end;
DCB.Id := FCommId;
SetCommState(DCB);
end;
procedure TKPComm.ClosePort;
begin
{ Set FPortOpen first to prevent stale WM_COMMNOTIFY processing }
FPortOpen := False;
if FCommId >= 0 then
begin
if FBreakState then
begin
ClearCommBreak(FCommId);
FBreakState := False;
end;
EscapeCommFunction(FCommId, CLRDTR);
EscapeCommFunction(FCommId, CLRRTS);
CloseComm(FCommId);
FCommId := -1;
end;
if FHWndNotify <> 0 then
begin
DestroyWindow(FHWndNotify);
FHWndNotify := 0;
end;
FCTSState := False;
FDSRState := False;
FCDState := False;
end;
constructor TKPComm.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FCommId := -1;
FHWndNotify := 0;
FCommPort := 1;
FSettings := '9600,N,8,1';
FPortOpen := False;
FInBufferSize := 4096;
FOutBufferSize := 4096;
FRThreshold := 0;
FSThreshold := 0;
FHandshaking := hsNone;
FInputLen := 0;
FInputMode := imText;
FDTREnable := True;
FRTSEnable := True;
FNullDiscard := False;
FEOFEnable := False;
FParityReplace := '?';
FBreakState := False;
FCommEvent := 0;
FCTSState := False;
FDSRState := False;
FCDState := False;
end;
destructor TKPComm.Destroy;
begin
if FPortOpen then
ClosePort;
inherited Destroy;
end;
procedure TKPComm.DoCommEvent(EventCode: Integer);
begin
FCommEvent := EventCode;
if Assigned(FOnComm) then
FOnComm(Self);
end;
function TKPComm.GetInBufferCount: Integer;
var
Stat: TComStat;
begin
Result := 0;
if not FPortOpen or (FCommId < 0) then
Exit;
GetCommError(FCommId, Stat);
Result := Stat.cbInQue;
end;
function TKPComm.GetInput: string;
var
Stat: TComStat;
BytesToRead: Integer;
BytesRead: Integer;
Buf: array[0..255] of Char;
begin
Result := '';
if not FPortOpen or (FCommId < 0) then
Exit;
GetCommError(FCommId, Stat);
BytesToRead := Stat.cbInQue;
if (FInputLen > 0) and (BytesToRead > FInputLen) then
BytesToRead := FInputLen;
if BytesToRead > 255 then
BytesToRead := 255;
if BytesToRead <= 0 then
Exit;
BytesRead := ReadComm(FCommId, @Buf, BytesToRead);
if BytesRead <= 0 then
Exit;
{ Set string length and copy data directly -- preserves embedded nulls }
{ for binary mode, and works correctly for text mode as well. }
Result[0] := Chr(BytesRead);
Move(Buf, Result[1], BytesRead);
end;
function TKPComm.GetOutBufferCount: Integer;
var
Stat: TComStat;
begin
Result := 0;
if not FPortOpen or (FCommId < 0) then
Exit;
GetCommError(FCommId, Stat);
Result := Stat.cbOutQue;
end;
procedure TKPComm.OpenPort;
var
WC: TWndClass;
DCB: TDCB;
Buf: array[0..255] of Char;
Setting: string;
RxTh: Integer;
TxTh: Integer;
begin
{ Open the comm port }
StrPCopy(Buf, 'COM' + IntToStr(FCommPort));
FCommId := OpenComm(Buf, FInBufferSize, FOutBufferSize);
if FCommId < 0 then
raise Exception.Create('Cannot open COM' + IntToStr(FCommPort) +
' (error ' + IntToStr(FCommId) + ')');
{ Configure baud/parity/data/stop from Settings string }
if GetCommState(FCommId, DCB) <> 0 then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('GetCommState failed');
end;
Setting := 'COM' + IntToStr(FCommPort) + ':' + FSettings;
StrPCopy(Buf, Setting);
if BuildCommDCB(Buf, DCB) <> 0 then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('Invalid Settings: ' + FSettings);
end;
DCB.Flags := DCB.Flags or dcbBinary;
DCB.Id := FCommId;
if SetCommState(DCB) <> 0 then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('SetCommState failed');
end;
{ Apply handshaking }
ApplyHandshaking;
{ Apply null-discard and parity-replace }
ApplyOptions;
{ Set DTR and RTS lines }
if FDTREnable then
EscapeCommFunction(FCommId, SETDTR)
else
EscapeCommFunction(FCommId, CLRDTR);
if FRTSEnable then
EscapeCommFunction(FCommId, SETRTS)
else
EscapeCommFunction(FCommId, CLRRTS);
{ Register notification window class (once per process) }
if not NotifyClassRegistered then
begin
FillChar(WC, SizeOf(WC), 0);
WC.lpfnWndProc := @NotifyWndProc;
WC.cbWndExtra := SizeOf(Longint);
WC.hInstance := HInstance;
WC.lpszClassName := NotifyClassName;
if not RegisterClass(WC) then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('RegisterClass failed');
end;
NotifyClassRegistered := True;
end;
{ Create hidden notification window and store Self for dispatch }
FHWndNotify := CreateWindow(NotifyClassName, '', ws_Popup,
0, 0, 0, 0, 0, 0, HInstance, nil);
if FHWndNotify = 0 then
begin
CloseComm(FCommId);
FCommId := -1;
raise Exception.Create('CreateWindow failed');
end;
SetWindowLong(FHWndNotify, 0, Longint(Self));
{ Enable event mask for modem status, errors, and breaks }
SetCommEventMask(FCommId,
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or
ev_Err or ev_Break or ev_RxChar);
{ Enable comm notifications -- -1 disables the notification }
if FRThreshold > 0 then
RxTh := FRThreshold
else
RxTh := -1;
if FSThreshold > 0 then
TxTh := FSThreshold
else
TxTh := -1;
EnableCommNotification(FCommId, FHWndNotify, RxTh, TxTh);
{ Reset modem line shadow state }
FCTSState := False;
FDSRState := False;
FCDState := False;
FPortOpen := True;
end;
procedure TKPComm.ProcessEventNotify;
var
EvtMask: Word;
Stat: TComStat;
ErrFlags: Integer;
begin
EvtMask := GetCommEventMask(FCommId,
ev_CTS or ev_DSR or ev_RLSD or ev_Ring or ev_Err or ev_Break);
if (EvtMask and ev_Break) <> 0 then
DoCommEvent(comEvtBreak);
{ Modem line shadow state: toggle on each transition event. }
{ The 16-bit comm API only provides transition events, not }
{ absolute line levels. }
if (EvtMask and ev_CTS) <> 0 then
begin
FCTSState := not FCTSState;
DoCommEvent(comEvCTS);
end;
if (EvtMask and ev_DSR) <> 0 then
begin
FDSRState := not FDSRState;
DoCommEvent(comEvDSR);
end;
if (EvtMask and ev_RLSD) <> 0 then
begin
FCDState := not FCDState;
DoCommEvent(comEvCD);
end;
if (EvtMask and ev_Ring) <> 0 then
DoCommEvent(comEvRing);
if (EvtMask and ev_Err) <> 0 then
begin
ErrFlags := GetCommError(FCommId, Stat);
if (ErrFlags and ce_Frame) <> 0 then
DoCommEvent(comEvtFrame);
if (ErrFlags and ce_Overrun) <> 0 then
DoCommEvent(comEvtOverrun);
if (ErrFlags and ce_RxOver) <> 0 then
DoCommEvent(comEvtRxOver);
if (ErrFlags and ce_RxParity) <> 0 then
DoCommEvent(comEvtParity);
if (ErrFlags and ce_TxFull) <> 0 then
DoCommEvent(comEvtTxFull);
end;
end;
procedure TKPComm.ProcessReceiveNotify;
var
Stat: TComStat;
begin
if FRThreshold <= 0 then
Exit;
GetCommError(FCommId, Stat);
if Integer(Stat.cbInQue) >= FRThreshold then
DoCommEvent(comEvReceive);
end;
procedure TKPComm.ProcessTransmitNotify;
var
Stat: TComStat;
begin
if FSThreshold <= 0 then
Exit;
GetCommError(FCommId, Stat);
if Integer(Stat.cbOutQue) <= FSThreshold then
DoCommEvent(comEvSend);
end;
procedure TKPComm.SetBreak(Value: Boolean);
begin
FBreakState := Value;
if FPortOpen and (FCommId >= 0) then
begin
if FBreakState then
SetCommBreak(FCommId)
else
ClearCommBreak(FCommId);
end;
end;
procedure TKPComm.SetCommPort(Value: Integer);
begin
if FPortOpen then
raise Exception.Create('Cannot change CommPort while port is open');
if (Value < 1) or (Value > 16) then
raise Exception.Create('CommPort must be 1..16');
FCommPort := Value;
end;
procedure TKPComm.SetDTREnable(Value: Boolean);
begin
FDTREnable := Value;
if FPortOpen and (FCommId >= 0) then
begin
if FDTREnable then
EscapeCommFunction(FCommId, SETDTR)
else
EscapeCommFunction(FCommId, CLRDTR);
end;
end;
procedure TKPComm.SetHandshaking(Value: THandshaking);
begin
FHandshaking := Value;
if FPortOpen and (FCommId >= 0) then
ApplyHandshaking;
end;
procedure TKPComm.SetInBufferSize(Value: Integer);
begin
if FPortOpen then
raise Exception.Create('Cannot change InBufferSize while port is open');
if Value < 64 then
raise Exception.Create('InBufferSize must be >= 64');
FInBufferSize := Value;
end;
procedure TKPComm.SetNullDiscard(Value: Boolean);
begin
FNullDiscard := Value;
if FPortOpen and (FCommId >= 0) then
ApplyOptions;
end;
procedure TKPComm.SetOutBufferSize(Value: Integer);
begin
if FPortOpen then
raise Exception.Create('Cannot change OutBufferSize while port is open');
if Value < 64 then
raise Exception.Create('OutBufferSize must be >= 64');
FOutBufferSize := Value;
end;
procedure TKPComm.SetOutput(const Value: string);
var
Written: Integer;
begin
if not FPortOpen or (FCommId < 0) then
raise Exception.Create('Port is not open');
if Length(Value) > 0 then
begin
Written := WriteComm(FCommId, @Value[1], Length(Value));
if Written < 0 then
DoCommEvent(comEvtTxFull);
end;
end;
procedure TKPComm.SetParityReplace(const Value: string);
begin
FParityReplace := Value;
if FPortOpen and (FCommId >= 0) then
ApplyOptions;
end;
procedure TKPComm.SetPortOpen(Value: Boolean);
begin
if Value = FPortOpen then
Exit;
if Value then
OpenPort
else
ClosePort;
end;
procedure TKPComm.SetRTSEnable(Value: Boolean);
begin
FRTSEnable := Value;
if FPortOpen and (FCommId >= 0) then
begin
if FRTSEnable then
EscapeCommFunction(FCommId, SETRTS)
else
EscapeCommFunction(FCommId, CLRRTS);
end;
end;
procedure TKPComm.SetSettings(const Value: string);
var
DCB: TDCB;
Buf: array[0..255] of Char;
Setting: string;
begin
FSettings := Value;
if FPortOpen and (FCommId >= 0) then
begin
if GetCommState(FCommId, DCB) <> 0 then
Exit;
Setting := 'COM' + IntToStr(FCommPort) + ':' + FSettings;
StrPCopy(Buf, Setting);
if BuildCommDCB(Buf, DCB) <> 0 then
Exit;
DCB.Flags := DCB.Flags or dcbBinary;
DCB.Id := FCommId;
SetCommState(DCB);
end;
end;
{ ----------------------------------------------------------------------- }
{ Component registration }
{ ----------------------------------------------------------------------- }
procedure Register;
begin
RegisterComponents('KP', [TKPComm]);
end;
end.

11
delphi/KPTEST.DPR
View file

@ -1,11 +0,0 @@
program KPTest;
uses
Forms,
TestMain in 'TESTMAIN.PAS',
KPComm in 'KPCOMM.PAS';
begin
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.

267
delphi/TESTMAIN.PAS
View file

@ -1,267 +0,0 @@
unit TestMain;
{ Test application for the TKPComm serial communications component. }
{ Form and all controls are created in code (no DFM required). }
interface
uses
SysUtils, Classes, WinTypes, WinProcs, Messages,
Forms, Controls, StdCtrls, KPComm;
type
TMainForm = class(TForm)
private
FComm: TKPComm;
FLabelPort: TLabel;
FEditPort: TEdit;
FLabelSettings: TLabel;
FEditSettings: TEdit;
FBtnOpen: TButton;
FBtnClose: TButton;
FLabelStatus: TLabel;
FLabelRecv: TLabel;
FMemoRecv: TMemo;
FEditSend: TEdit;
FBtnSend: TButton;
FLabelInfo: TLabel;
procedure BtnCloseClick(Sender: TObject);
procedure BtnOpenClick(Sender: TObject);
procedure BtnSendClick(Sender: TObject);
procedure CommEvent(Sender: TObject);
procedure UpdateStatus;
public
constructor Create(AOwner: TComponent); override;
end;
var
MainForm: TMainForm;
implementation
procedure TMainForm.BtnCloseClick(Sender: TObject);
begin
FComm.PortOpen := False;
FMemoRecv.Lines.Add('--- Port closed ---');
UpdateStatus;
end;
procedure TMainForm.BtnOpenClick(Sender: TObject);
begin
try
FComm.CommPort := StrToInt(FEditPort.Text);
FComm.Settings := FEditSettings.Text;
FComm.RThreshold := 1;
FComm.PortOpen := True;
FMemoRecv.Lines.Add('--- Port opened on COM' +
FEditPort.Text + ' at ' + FEditSettings.Text + ' ---');
except
on E: Exception do
FMemoRecv.Lines.Add('Open failed: ' + E.Message);
end;
UpdateStatus;
end;
procedure TMainForm.BtnSendClick(Sender: TObject);
begin
if Length(FEditSend.Text) = 0 then
Exit;
try
FComm.Output := FEditSend.Text + #13;
FMemoRecv.Lines.Add('TX: ' + FEditSend.Text);
FEditSend.Text := '';
except
on E: Exception do
FMemoRecv.Lines.Add('Send failed: ' + E.Message);
end;
UpdateStatus;
end;
procedure TMainForm.CommEvent(Sender: TObject);
var
S: string;
begin
case FComm.CommEvent of
comEvReceive:
begin
S := FComm.Input;
if Length(S) > 0 then
FMemoRecv.Lines.Add('RX: ' + S);
end;
comEvCTS:
FMemoRecv.Lines.Add('CTS changed');
comEvDSR:
FMemoRecv.Lines.Add('DSR changed');
comEvCD:
FMemoRecv.Lines.Add('CD changed');
comEvRing:
FMemoRecv.Lines.Add('Ring');
comEvEOF:
FMemoRecv.Lines.Add('EOF received');
comEvtBreak:
FMemoRecv.Lines.Add('Break received');
comEvtFrame:
FMemoRecv.Lines.Add('Framing error');
comEvtOverrun:
FMemoRecv.Lines.Add('Overrun error');
comEvtRxOver:
FMemoRecv.Lines.Add('RX buffer overflow');
comEvtParity:
FMemoRecv.Lines.Add('Parity error');
comEvtTxFull:
FMemoRecv.Lines.Add('TX buffer full');
end;
UpdateStatus;
end;
constructor TMainForm.Create(AOwner: TComponent);
begin
inherited CreateNew(AOwner);
Caption := 'KPComm Test';
Width := 500;
Height := 380;
BorderStyle := bsSingle;
{ Serial component }
FComm := TKPComm.Create(Self);
FComm.OnComm := CommEvent;
{ Row 1: Port and Settings }
FLabelPort := TLabel.Create(Self);
FLabelPort.Parent := Self;
FLabelPort.Left := 8;
FLabelPort.Top := 12;
FLabelPort.Caption := 'Port:';
FEditPort := TEdit.Create(Self);
FEditPort.Parent := Self;
FEditPort.Left := 44;
FEditPort.Top := 8;
FEditPort.Width := 32;
FEditPort.Text := '1';
FLabelSettings := TLabel.Create(Self);
FLabelSettings.Parent := Self;
FLabelSettings.Left := 88;
FLabelSettings.Top := 12;
FLabelSettings.Caption := 'Settings:';
FEditSettings := TEdit.Create(Self);
FEditSettings.Parent := Self;
FEditSettings.Left := 148;
FEditSettings.Top := 8;
FEditSettings.Width := 140;
FEditSettings.Text := '9600,N,8,1';
{ Row 2: Open/Close buttons and status }
FBtnOpen := TButton.Create(Self);
FBtnOpen.Parent := Self;
FBtnOpen.Left := 8;
FBtnOpen.Top := 38;
FBtnOpen.Width := 65;
FBtnOpen.Height := 25;
FBtnOpen.Caption := 'Open';
FBtnOpen.OnClick := BtnOpenClick;
FBtnClose := TButton.Create(Self);
FBtnClose.Parent := Self;
FBtnClose.Left := 80;
FBtnClose.Top := 38;
FBtnClose.Width := 65;
FBtnClose.Height := 25;
FBtnClose.Caption := 'Close';
FBtnClose.Enabled := False;
FBtnClose.OnClick := BtnCloseClick;
FLabelStatus := TLabel.Create(Self);
FLabelStatus.Parent := Self;
FLabelStatus.Left := 160;
FLabelStatus.Top := 44;
FLabelStatus.Caption := 'Closed';
{ Receive area }
FLabelRecv := TLabel.Create(Self);
FLabelRecv.Parent := Self;
FLabelRecv.Left := 8;
FLabelRecv.Top := 70;
FLabelRecv.Caption := 'Received:';
FMemoRecv := TMemo.Create(Self);
FMemoRecv.Parent := Self;
FMemoRecv.Left := 8;
FMemoRecv.Top := 86;
FMemoRecv.Width := 476;
FMemoRecv.Height := 186;
FMemoRecv.ScrollBars := ssVertical;
FMemoRecv.ReadOnly := True;
{ Send row }
FEditSend := TEdit.Create(Self);
FEditSend.Parent := Self;
FEditSend.Left := 8;
FEditSend.Top := 280;
FEditSend.Width := 400;
FBtnSend := TButton.Create(Self);
FBtnSend.Parent := Self;
FBtnSend.Left := 416;
FBtnSend.Top := 280;
FBtnSend.Width := 65;
FBtnSend.Height := 25;
FBtnSend.Caption := 'Send';
FBtnSend.Enabled := False;
FBtnSend.OnClick := BtnSendClick;
{ Status info line }
FLabelInfo := TLabel.Create(Self);
FLabelInfo.Parent := Self;
FLabelInfo.Left := 8;
FLabelInfo.Top := 316;
FLabelInfo.Width := 476;
FLabelInfo.Caption := 'RX: 0 TX: 0 Event: 0';
end;
procedure TMainForm.UpdateStatus;
var
S: string;
begin
if FComm.PortOpen then
FLabelStatus.Caption := 'Open'
else
FLabelStatus.Caption := 'Closed';
FBtnOpen.Enabled := not FComm.PortOpen;
FBtnClose.Enabled := FComm.PortOpen;
FBtnSend.Enabled := FComm.PortOpen;
FEditSend.Enabled := FComm.PortOpen;
S := 'RX: ' + IntToStr(FComm.InBufferCount) +
' TX: ' + IntToStr(FComm.OutBufferCount);
if FComm.PortOpen then
begin
if FComm.CTSHolding then
S := S + ' CTS: On'
else
S := S + ' CTS: Off';
if FComm.DSRHolding then
S := S + ' DSR: On'
else
S := S + ' DSR: Off';
if FComm.CDHolding then
S := S + ' CD: On'
else
S := S + ' CD: Off';
end;
S := S + ' Event: ' + IntToStr(FComm.CommEvent);
FLabelInfo.Caption := S;
end;
end.

7
vbx/kpcomctl.rc
View file

@ -1,7 +0,0 @@
// kpcomctl.rc - KPComCtl VBX resource script
//
// Defines the toolbox bitmap displayed in the VB IDE custom controls palette.
#include "kpcomctl.h"
IDB_KPCOMCTL BITMAP kpcomctl.bmp

33
vbx/makefile
View file

@ -1,4 +1,4 @@
# makefile - KPComCtl VBX control for MSVC 1.52
# makefile - MSComm VBX control for MSVC 1.52
#
# Build: nmake
# Clean: nmake clean
@ -11,14 +11,17 @@
# The stock Windows 3.1 COMM.DRV enables the 16550 FIFO for receive only,
# with a trigger level of 14 (leaving only 2 bytes of headroom). This causes
# overruns at baud rates above 9600 under load. For reliable operation at
# 57600 or 115200, install KPCOMM.DRV (built from ..\drv\) or CyberCom
# V1.1.0.0P (..\drivers\CYBERCOM.DRV).
# 57600 or 115200, install CyberCom V1.1.0.0P -- a freeware drop-in
# replacement included in ..\drivers\CYBERCOM.DRV. It enables both RX and TX
# FIFOs with a trigger level of 8, dramatically reducing interrupt overhead.
#
# Install (KPCOMM):
# 1. Copy ..\drv\KPCOMM.DRV to \WINDOWS\SYSTEM
# 2. Edit SYSTEM.INI [boot] section: comm.drv=kpcomm.drv
# Install:
# 1. Copy ..\drivers\CYBERCOM.DRV to \WINDOWS\SYSTEM
# 2. Edit SYSTEM.INI [boot] section: comm.drv=cybercom.drv
# 3. Add to [386Enh] section: COM1FIFO=1 (for each port in use)
# 4. Restart Windows
#
# CyberCom is free for non-commercial use. (C) CyberSoft Corp 1993
CC = cl
LINK = link
@ -48,28 +51,28 @@ LFLAGS = /NOD /NOE /AL:16
LIBS = sdllcew libw commdlg vbapi
# Output
TARGET = kpcomctl.vbx
TARGET = mscomm.vbx
# Objects
OBJS = kpcomctl.obj serial.obj
OBJS = mscomm.obj serial.obj
# -----------------------------------------------------------------------
# Build rules
# -----------------------------------------------------------------------
all: $(TARGET)
$(TARGET): $(OBJS) kpcomctl.def kpcomctl.res vbapi.lib
$(LINK) $(LFLAGS) $(OBJS), $(TARGET),,$(LIBS), kpcomctl.def
$(RC) kpcomctl.res $(TARGET)
$(TARGET): $(OBJS) mscomm.def mscomm.res vbapi.lib
$(LINK) $(LFLAGS) $(OBJS), $(TARGET),,$(LIBS), mscomm.def
$(RC) mscomm.res $(TARGET)
kpcomctl.obj: kpcomctl.c kpcomctl.h vbapi.h serial.h
$(CC) $(CFLAGS) kpcomctl.c
mscomm.obj: mscomm.c mscomm.h vbapi.h serial.h
$(CC) $(CFLAGS) mscomm.c
serial.obj: serial.c serial.h
$(CC) $(CFLAGS) serial.c
kpcomctl.res: kpcomctl.rc kpcomctl.h kpcomctl.bmp
$(RC) -r kpcomctl.rc
mscomm.res: mscomm.rc mscomm.h mscomm.bmp
$(RC) -r mscomm.rc
# -----------------------------------------------------------------------
# Generate VBAPI.LIB from vbapi.def if not present

0
vbx/kpcomctl.bmp → vbx/mscomm.bmp
View file

84
vbx/kpcomctl.c → vbx/mscomm.c
View file

@ -1,4 +1,4 @@
// kpcomctl.c - KPComCtl VBX control implementation
// mscomm.c - MSComm VBX control implementation
//
// Provides high-speed serial communications for 16-bit Visual Basic 4.
// Implements MODEL, control procedure, property/event handling, and
@ -13,7 +13,7 @@
#include <string.h>
#include "vbapi.h"
#include "serial.h"
#include "kpcomctl.h"
#include "mscomm.h"
// -----------------------------------------------------------------------
// Global data
@ -23,23 +23,23 @@ HANDLE ghInstance = NULL;
// -----------------------------------------------------------------------
// Convenience macro for re-dereferencing control data after VB API calls
// -----------------------------------------------------------------------
#define DEREF(hctl) ((KpComCtlDataT FAR *)VBDerefControl(hctl))
#define DEREF(hctl) ((MsCommDataT FAR *)VBDerefControl(hctl))
// -----------------------------------------------------------------------
// Forward declarations - Control procedure
// -----------------------------------------------------------------------
LONG FAR PASCAL _export KpComCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp, LONG lp);
LONG FAR PASCAL _export MsCommCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp, LONG lp);
LRESULT FAR PASCAL _export NotifyWndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM lp);
// -----------------------------------------------------------------------
// Forward declarations - Internal functions (alphabetical)
// -----------------------------------------------------------------------
static void closePort(HCTL hctl, KpComCtlDataT FAR *pData);
static void fireOnComm(HCTL hctl, KpComCtlDataT FAR *pData, int16_t eventCode);
static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp);
static LONG handleSetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp, LONG lp);
static void closePort(HCTL hctl, MsCommDataT FAR *pData);
static void fireOnComm(HCTL hctl, MsCommDataT FAR *pData, int16_t eventCode);
static LONG handleGetProperty(HCTL hctl, MsCommDataT FAR *pData, USHORT iProp);
static LONG handleSetProperty(HCTL hctl, MsCommDataT FAR *pData, USHORT iProp, LONG lp);
static void initControlData(HCTL hctl);
static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData);
static int16_t openPort(HCTL hctl, MsCommDataT FAR *pData);
static void processEventNotify(HCTL hctl, int16_t commId);
static void processReceiveNotify(HCTL hctl, int16_t commId);
static void processTransmitNotify(HCTL hctl, int16_t commId);
@ -63,29 +63,29 @@ static char szInputMode[] = "Text\0Binary";
// Property descriptors
// -----------------------------------------------------------------------
// offset default enum list enumMax
static PROPINFO propCommPort = { "CommPort", PF_fSetMsg | PF_fGetData | DT_SHORT, OFFSETIN(KpComCtlDataT, commPort), 0, 1L, NULL, 0 };
static PROPINFO propCommPort = { "CommPort", PF_fSetMsg | PF_fGetData | DT_SHORT, OFFSETIN(MsCommDataT, commPort), 0, 1L, NULL, 0 };
static PROPINFO propSettings = { "Settings", PF_fSetMsg | PF_fGetMsg | DT_HSZ, 0, 0, 0L, NULL, 0 };
static PROPINFO propPortOpen = { "PortOpen", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(KpComCtlDataT, portOpen), 0, 0L, NULL, 0 };
static PROPINFO propPortOpen = { "PortOpen", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(MsCommDataT, portOpen), 0, 0L, NULL, 0 };
static PROPINFO propInput = { "Input", PF_fGetMsg | PF_fNoShow | DT_HSZ, 0, 0, 0L, NULL, 0 };
static PROPINFO propOutput = { "Output", PF_fSetMsg | PF_fNoShow | DT_HSZ, 0, 0, 0L, NULL, 0 };
static PROPINFO propInBufferSize = { "InBufferSize", PF_fSetMsg | PF_fGetData | DT_SHORT, OFFSETIN(KpComCtlDataT, inBufferSize), 0, 4096L, NULL, 0 };
static PROPINFO propOutBufferSize = { "OutBufferSize", PF_fSetMsg | PF_fGetData | DT_SHORT, OFFSETIN(KpComCtlDataT, outBufferSize), 0, 4096L, NULL, 0 };
static PROPINFO propInBufferSize = { "InBufferSize", PF_fSetMsg | PF_fGetData | DT_SHORT, OFFSETIN(MsCommDataT, inBufferSize), 0, 4096L, NULL, 0 };
static PROPINFO propOutBufferSize = { "OutBufferSize", PF_fSetMsg | PF_fGetData | DT_SHORT, OFFSETIN(MsCommDataT, outBufferSize), 0, 4096L, NULL, 0 };
static PROPINFO propInBufferCount = { "InBufferCount", PF_fGetMsg | PF_fNoShow | DT_SHORT, 0, 0, 0L, NULL, 0 };
static PROPINFO propOutBufferCount= { "OutBufferCount",PF_fGetMsg | PF_fNoShow | DT_SHORT, 0, 0, 0L, NULL, 0 };
static PROPINFO propRThreshold = { "RThreshold", PF_fSetData| PF_fGetData | DT_SHORT, OFFSETIN(KpComCtlDataT, rThreshold), 0, 0L, NULL, 0 };
static PROPINFO propSThreshold = { "SThreshold", PF_fSetData| PF_fGetData | DT_SHORT, OFFSETIN(KpComCtlDataT, sThreshold), 0, 0L, NULL, 0 };
static PROPINFO propHandshaking = { "Handshaking", PF_fSetMsg | PF_fGetData | DT_ENUM, OFFSETIN(KpComCtlDataT, handshaking), 0, 0L, szHandshaking, 3 };
static PROPINFO propInputLen = { "InputLen", PF_fSetData| PF_fGetData | DT_SHORT, OFFSETIN(KpComCtlDataT, inputLen), 0, 0L, NULL, 0 };
static PROPINFO propInputMode = { "InputMode", PF_fSetData| PF_fGetData | DT_ENUM, OFFSETIN(KpComCtlDataT, inputMode), 0, 0L, szInputMode, 1 };
static PROPINFO propDTREnable = { "DTREnable", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(KpComCtlDataT, dtrEnable), 0, 1L, NULL, 0 };
static PROPINFO propRTSEnable = { "RTSEnable", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(KpComCtlDataT, rtsEnable), 0, 1L, NULL, 0 };
static PROPINFO propRThreshold = { "RThreshold", PF_fSetData| PF_fGetData | DT_SHORT, OFFSETIN(MsCommDataT, rThreshold), 0, 0L, NULL, 0 };
static PROPINFO propSThreshold = { "SThreshold", PF_fSetData| PF_fGetData | DT_SHORT, OFFSETIN(MsCommDataT, sThreshold), 0, 0L, NULL, 0 };
static PROPINFO propHandshaking = { "Handshaking", PF_fSetMsg | PF_fGetData | DT_ENUM, OFFSETIN(MsCommDataT, handshaking), 0, 0L, szHandshaking, 3 };
static PROPINFO propInputLen = { "InputLen", PF_fSetData| PF_fGetData | DT_SHORT, OFFSETIN(MsCommDataT, inputLen), 0, 0L, NULL, 0 };
static PROPINFO propInputMode = { "InputMode", PF_fSetData| PF_fGetData | DT_ENUM, OFFSETIN(MsCommDataT, inputMode), 0, 0L, szInputMode, 1 };
static PROPINFO propDTREnable = { "DTREnable", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(MsCommDataT, dtrEnable), 0, 1L, NULL, 0 };
static PROPINFO propRTSEnable = { "RTSEnable", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(MsCommDataT, rtsEnable), 0, 1L, NULL, 0 };
static PROPINFO propCDHolding = { "CDHolding", PF_fGetMsg | PF_fNoShow | DT_BOOL, 0, 0, 0L, NULL, 0 };
static PROPINFO propCTSHolding = { "CTSHolding", PF_fGetMsg | PF_fNoShow | DT_BOOL, 0, 0, 0L, NULL, 0 };
static PROPINFO propDSRHolding = { "DSRHolding", PF_fGetMsg | PF_fNoShow | DT_BOOL, 0, 0, 0L, NULL, 0 };
static PROPINFO propBreak = { "Break", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(KpComCtlDataT, breakState), 0, 0L, NULL, 0 };
static PROPINFO propCommEvent = { "CommEvent", PF_fGetData| PF_fNoShow | DT_SHORT, OFFSETIN(KpComCtlDataT, commEvent), 0, 0L, NULL, 0 };
static PROPINFO propNullDiscard = { "NullDiscard", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(KpComCtlDataT, nullDiscard), 0, 0L, NULL, 0 };
static PROPINFO propEOFEnable = { "EOFEnable", PF_fSetData| PF_fGetData | DT_BOOL, OFFSETIN(KpComCtlDataT, eofEnable), 0, 0L, NULL, 0 };
static PROPINFO propBreak = { "Break", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(MsCommDataT, breakState), 0, 0L, NULL, 0 };
static PROPINFO propCommEvent = { "CommEvent", PF_fGetData| PF_fNoShow | DT_SHORT, OFFSETIN(MsCommDataT, commEvent), 0, 0L, NULL, 0 };
static PROPINFO propNullDiscard = { "NullDiscard", PF_fSetMsg | PF_fGetData | DT_BOOL, OFFSETIN(MsCommDataT, nullDiscard), 0, 0L, NULL, 0 };
static PROPINFO propEOFEnable = { "EOFEnable", PF_fSetData| PF_fGetData | DT_BOOL, OFFSETIN(MsCommDataT, eofEnable), 0, 0L, NULL, 0 };
static PROPINFO propParityReplace = { "ParityReplace", PF_fSetMsg | PF_fGetMsg | DT_HSZ, 0, 0, 0L, NULL, 0 };
// -----------------------------------------------------------------------
@ -138,16 +138,16 @@ static PEVENTINFO eventList[] = {
// -----------------------------------------------------------------------
// MODEL definition
// -----------------------------------------------------------------------
static char szCtlName[] = "KPComCtl";
static char szCtlName[] = "MSComm";
MODEL modelKpComCtl = {
MODEL modelMsComm = {
VB300_VERSION, // usVersion
MODEL_fInitMsg | MODEL_fInvisAtRun,// fl
(PCTLPROC)KpComCtlProc, // pctlproc
(PCTLPROC)MsCommCtlProc, // pctlproc
0, // fsClassStyle
WS_CHILD, // flWndStyle
sizeof(KpComCtlDataT), // cbCtlExtra
IDB_KPCOMCTL, // idBmpPalette
sizeof(MsCommDataT), // cbCtlExtra
IDB_MSCOMM, // idBmpPalette
szCtlName, // npszDefCtlName
NULL, // npszClassName
NULL, // npszParentClassName
@ -169,7 +169,7 @@ MODEL modelKpComCtl = {
//
// No VB API calls here, so pData remains valid throughout.
// -----------------------------------------------------------------------
static void closePort(HCTL hctl, KpComCtlDataT FAR *pData)
static void closePort(HCTL hctl, MsCommDataT FAR *pData)
{
if (pData->commId >= 0) {
if (pData->breakState) {
@ -199,7 +199,7 @@ static void closePort(HCTL hctl, KpComCtlDataT FAR *pData)
// WARNING: After this function returns, any previously obtained pData
// pointer is INVALID. Callers must re-deref via DEREF(hctl).
// -----------------------------------------------------------------------
static void fireOnComm(HCTL hctl, KpComCtlDataT FAR *pData, int16_t eventCode)
static void fireOnComm(HCTL hctl, MsCommDataT FAR *pData, int16_t eventCode)
{
pData->commEvent = eventCode;
VBFireEvent(hctl, IEVENT_ONCOMM, NULL);
@ -210,7 +210,7 @@ static void fireOnComm(HCTL hctl, KpComCtlDataT FAR *pData, int16_t eventCode)
// -----------------------------------------------------------------------
// handleGetProperty - Process VBM_GETPROPERTY for message-based props
// -----------------------------------------------------------------------
static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp)
static LONG handleGetProperty(HCTL hctl, MsCommDataT FAR *pData, USHORT iProp)
{
switch (iProp) {
case IPROP_SETTINGS:
@ -308,7 +308,7 @@ static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp)
// -----------------------------------------------------------------------
// handleSetProperty - Process VBM_SETPROPERTY for message-based props
// -----------------------------------------------------------------------
static LONG handleSetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp, LONG lp)
static LONG handleSetProperty(HCTL hctl, MsCommDataT FAR *pData, USHORT iProp, LONG lp)
{
int16_t val;
@ -511,7 +511,7 @@ static LONG handleSetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp,
// -----------------------------------------------------------------------
static void initControlData(HCTL hctl)
{
KpComCtlDataT FAR *pData;
MsCommDataT FAR *pData;
HSZ hsz;
pData = DEREF(hctl);
@ -553,7 +553,7 @@ static void initControlData(HCTL hctl)
// Saves all needed control data to locals before VB API calls to avoid
// stale pointer issues. Re-derefs when writing results back.
// -----------------------------------------------------------------------
static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData)
static int16_t openPort(HCTL hctl, MsCommDataT FAR *pData)
{
int16_t commId;
int16_t port;
@ -653,7 +653,7 @@ static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData)
// -----------------------------------------------------------------------
static void processEventNotify(HCTL hctl, int16_t commId)
{
KpComCtlDataT FAR *pData;
MsCommDataT FAR *pData;
UINT evtMask;
evtMask = serialGetEventMask(commId, EV_CTS | EV_DSR | EV_RLSD | EV_RING | EV_ERR | EV_BREAK);
@ -721,7 +721,7 @@ static void processEventNotify(HCTL hctl, int16_t commId)
// -----------------------------------------------------------------------
static void processReceiveNotify(HCTL hctl, int16_t commId)
{
KpComCtlDataT FAR *pData;
MsCommDataT FAR *pData;
COMSTAT stat;
pData = DEREF(hctl);
@ -744,7 +744,7 @@ static void processReceiveNotify(HCTL hctl, int16_t commId)
// -----------------------------------------------------------------------
static void processTransmitNotify(HCTL hctl, int16_t commId)
{
KpComCtlDataT FAR *pData;
MsCommDataT FAR *pData;
COMSTAT stat;
pData = DEREF(hctl);
@ -796,7 +796,7 @@ LRESULT FAR PASCAL _export NotifyWndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM
{
if (msg == WM_COMMNOTIFY) {
HCTL hctl;
KpComCtlDataT FAR *pData;
MsCommDataT FAR *pData;
int16_t commId;
UINT notifyCode;
@ -836,9 +836,9 @@ LRESULT FAR PASCAL _export NotifyWndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM
// VBX Control procedure
// =======================================================================
LONG FAR PASCAL _export KpComCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp, LONG lp)
LONG FAR PASCAL _export MsCommCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp, LONG lp)
{
KpComCtlDataT FAR *pData;
MsCommDataT FAR *pData;
switch (msg) {
case VBM_INITIALIZE:
@ -913,7 +913,7 @@ BOOL FAR PASCAL _export VBINITCC(USHORT usVersion, BOOL fRuntime)
return FALSE;
}
return VBRegisterModel(ghInstance, &modelKpComCtl);
return VBRegisterModel(ghInstance, &modelMsComm);
}

6
vbx/kpcomctl.def → vbx/mscomm.def
View file

@ -1,7 +1,7 @@
; kpcomctl.def - Module definition for KPComCtl VBX control
; mscomm.def - Module definition for MSComm VBX control
LIBRARY KPCOMCTL
DESCRIPTION 'KPComCtl Serial Communications Control for VB4'
LIBRARY MSCOMM
DESCRIPTION 'MSComm Serial Communications Control for VB4'
EXETYPE WINDOWS
CODE PRELOAD MOVEABLE DISCARDABLE

14
vbx/kpcomctl.h → vbx/mscomm.h
View file

@ -1,14 +1,14 @@
// kpcomctl.h - KPComCtl VBX control definitions
// mscomm.h - MSComm VBX control definitions
//
// Property/event IDs, comm event constants, and control instance data.
#ifndef KPCOMCTL_H
#define KPCOMCTL_H
#ifndef MSCOMM_H
#define MSCOMM_H
// -----------------------------------------------------------------------
// Resource IDs
// -----------------------------------------------------------------------
#define IDB_KPCOMCTL 8000
#define IDB_MSCOMM 8000
#ifndef RC_INVOKED
@ -128,12 +128,12 @@ typedef struct {
BOOL dsrState; // Shadow state: DSR line level
BOOL cdState; // Shadow state: CD (RLSD) line level
HSZ hszParityReplace; // Parity error replacement character
} KpComCtlDataT;
} MsCommDataT;
// -----------------------------------------------------------------------
// Hidden notification window class name
// -----------------------------------------------------------------------
#define NOTIFY_CLASS "KpComCtlNotify"
#define NOTIFY_CLASS "MsCommNotify"
// -----------------------------------------------------------------------
// Global instance handle (set in LibMain)
@ -142,4 +142,4 @@ extern HANDLE ghInstance;
#endif // RC_INVOKED
#endif // KPCOMCTL_H
#endif // MSCOMM_H

7
vbx/mscomm.rc Normal file
View file

@ -0,0 +1,7 @@
// mscomm.rc - MSComm VBX resource script
//
// Defines the toolbox bitmap displayed in the VB IDE custom controls palette.
#include "mscomm.h"
IDB_MSCOMM BITMAP mscomm.bmp