VBX does not work. Moving to Delphi.

This commit is contained in:
Scott Duensing 2026-02-25 22:06:08 -06:00
parent dd8326d16a
commit c7dc74ecdc
6 changed files with 325 additions and 105 deletions

1
.gitignore vendored
View file

@ -18,3 +18,4 @@
# Backup files # Backup files
*.bak *.bak
*~ *~
vbapi/

View file

@ -15,10 +15,90 @@
#include "serial.h" #include "serial.h"
#include "kpcomctl.h" #include "kpcomctl.h"
// -----------------------------------------------------------------------
// Debug logging via OutputDebugString
// -----------------------------------------------------------------------
#define DBG_ENABLED 1
#if DBG_ENABLED
static void dbgStr(const char FAR *msg)
{
OutputDebugString(msg);
}
// Log a label and a 16-bit hex value: "label: 0xNNNN\r\n"
static void dbgHex16(const char FAR *label, uint16_t val)
{
static const char hex[] = "0123456789ABCDEF";
char buf[48];
int i;
for (i = 0; i < 40 && label[i]; i++) {
buf[i] = label[i];
}
buf[i++] = ':';
buf[i++] = ' ';
buf[i++] = '0';
buf[i++] = 'x';
buf[i++] = hex[(val >> 12) & 0xF];
buf[i++] = hex[(val >> 8) & 0xF];
buf[i++] = hex[(val >> 4) & 0xF];
buf[i++] = hex[val & 0xF];
buf[i++] = '\r';
buf[i++] = '\n';
buf[i] = '\0';
OutputDebugString(buf);
}
// Log a label and a signed 16-bit value: "label: -NNNN\r\n"
static void dbgInt16(const char FAR *label, int16_t val)
{
char buf[48];
int i;
uint16_t uv;
for (i = 0; i < 40 && label[i]; i++) {
buf[i] = label[i];
}
buf[i++] = ':';
buf[i++] = ' ';
if (val < 0) {
buf[i++] = '-';
uv = (uint16_t)(-(int)val);
} else {
uv = (uint16_t)val;
}
// Print decimal (up to 5 digits)
{
char digits[6];
int n = 0;
do {
digits[n++] = (char)('0' + (uv % 10));
uv /= 10;
} while (uv > 0);
while (n > 0) {
buf[i++] = digits[--n];
}
}
buf[i++] = '\r';
buf[i++] = '\n';
buf[i] = '\0';
OutputDebugString(buf);
}
#else
#define dbgStr(msg) ((void)0)
#define dbgHex16(label, val) ((void)0)
#define dbgInt16(label, val) ((void)0)
#endif
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Global data // Global data
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
HANDLE ghInstance = NULL; HANDLE ghInstance = NULL;
static BOOL gModelInfoCalled = FALSE;
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Convenience macro for re-dereferencing control data after VB API calls // Convenience macro for re-dereferencing control data after VB API calls
@ -48,10 +128,11 @@ static BOOL registerNotifyClass(HANDLE hInstance);
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Forward declarations - DLL entry points // Forward declarations - DLL entry points
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
int FAR PASCAL LibMain(HANDLE hInstance, WORD wDataSeg, WORD wHeapSize, LPSTR lpszCmdLine); int FAR PASCAL LibMain(HANDLE hInstance, WORD wDataSeg, WORD wHeapSize, LPSTR lpszCmdLine);
BOOL FAR PASCAL _export VBINITCC(USHORT usVersion, BOOL fRuntime); BOOL FAR PASCAL _export VBINITCC(USHORT usVersion, BOOL fRuntime);
void FAR PASCAL _export VBTERMCC(void); void FAR PASCAL _export VBTERMCC(void);
void FAR PASCAL _export WEP(int nParam); LPMODELINFO FAR PASCAL _export VBGetModelInfo(USHORT usVersion);
void FAR PASCAL _export WEP(int nParam);
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Enum value lists (null-separated, double-null terminated by compiler) // Enum value lists (null-separated, double-null terminated by compiler)
@ -142,7 +223,7 @@ static char szCtlName[] = "KPComCtl";
MODEL modelKpComCtl = { MODEL modelKpComCtl = {
VB300_VERSION, // usVersion VB300_VERSION, // usVersion
MODEL_fInitMsg | MODEL_fInvisAtRun,// fl MODEL_fInitMsg, // fl
(PCTLPROC)KpComCtlProc, // pctlproc (PCTLPROC)KpComCtlProc, // pctlproc
0, // fsClassStyle 0, // fsClassStyle
WS_CHILD, // flWndStyle WS_CHILD, // flWndStyle
@ -159,6 +240,22 @@ MODEL modelKpComCtl = {
0x0100 // usCtlVersion (1.00) 0x0100 // usCtlVersion (1.00)
}; };
// -----------------------------------------------------------------------
// MODELINFO for VBGetModelInfo (CIRC3 CDK pattern)
//
// File-scope globals with static initialization, exactly matching the
// CDK sample pattern. VB4 may call VBGetModelInfo after VBINITCC returns.
// -----------------------------------------------------------------------
LPMODEL gModelList[] = {
&modelKpComCtl,
NULL
};
MODELINFO gModelInfo = {
VB300_VERSION,
gModelList
};
// ======================================================================= // =======================================================================
// Internal helper functions (alphabetical) // Internal helper functions (alphabetical)
@ -171,6 +268,8 @@ MODEL modelKpComCtl = {
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static void closePort(HCTL hctl, KpComCtlDataT FAR *pData) static void closePort(HCTL hctl, KpComCtlDataT FAR *pData)
{ {
dbgInt16("KPCOMCTL: closePort commId", pData->commId);
if (pData->commId >= 0) { if (pData->commId >= 0) {
if (pData->breakState) { if (pData->breakState) {
serialEscape(pData->commId, SERIAL_CLRBREAK); serialEscape(pData->commId, SERIAL_CLRBREAK);
@ -201,6 +300,8 @@ static void closePort(HCTL hctl, KpComCtlDataT FAR *pData)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static void fireOnComm(HCTL hctl, KpComCtlDataT FAR *pData, int16_t eventCode) static void fireOnComm(HCTL hctl, KpComCtlDataT FAR *pData, int16_t eventCode)
{ {
dbgInt16("KPCOMCTL: fireOnComm code", eventCode);
pData->commEvent = eventCode; pData->commEvent = eventCode;
VBFireEvent(hctl, IEVENT_ONCOMM, NULL); VBFireEvent(hctl, IEVENT_ONCOMM, NULL);
// pData is now stale - caller must re-deref // pData is now stale - caller must re-deref
@ -212,6 +313,8 @@ static void fireOnComm(HCTL hctl, KpComCtlDataT FAR *pData, int16_t eventCode)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp) static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp)
{ {
dbgInt16("KPCOMCTL: getProp iProp", (int16_t)iProp);
switch (iProp) { switch (iProp) {
case IPROP_SETTINGS: case IPROP_SETTINGS:
return (LONG)pData->hszSettings; return (LONG)pData->hszSettings;
@ -227,7 +330,7 @@ static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp)
HSZ hsz; HSZ hsz;
if (!pData->portOpen || pData->commId < 0) { if (!pData->portOpen || pData->commId < 0) {
return (LONG)VBCreateHsz((_segment)0, ""); return (LONG)VBCreateHsz((HANDLE)0, "");
} }
// Save values to locals before any VB API calls // Save values to locals before any VB API calls
@ -242,13 +345,13 @@ static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp)
} }
if (bytesToRead <= 0) { if (bytesToRead <= 0) {
return (LONG)VBCreateHsz((_segment)0, ""); return (LONG)VBCreateHsz((HANDLE)0, "");
} }
// Use GlobalAlloc for potentially large buffers (DLL local heap is small) // Use GlobalAlloc for potentially large buffers (DLL local heap is small)
hMem = GlobalAlloc(GMEM_MOVEABLE, (DWORD)bytesToRead + 1); hMem = GlobalAlloc(GMEM_MOVEABLE, (DWORD)bytesToRead + 1);
if (hMem == NULL) { if (hMem == NULL) {
return (LONG)VBCreateHsz((_segment)0, ""); return (LONG)VBCreateHsz((HANDLE)0, "");
} }
buf = (char FAR *)GlobalLock(hMem); buf = (char FAR *)GlobalLock(hMem);
@ -256,11 +359,11 @@ static LONG handleGetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp)
if (bytesRead <= 0) { if (bytesRead <= 0) {
GlobalUnlock(hMem); GlobalUnlock(hMem);
GlobalFree(hMem); GlobalFree(hMem);
return (LONG)VBCreateHsz((_segment)0, ""); return (LONG)VBCreateHsz((HANDLE)0, "");
} }
buf[bytesRead] = '\0'; buf[bytesRead] = '\0';
hsz = VBCreateHsz((_segment)0, buf); hsz = VBCreateHsz((HANDLE)0, buf);
GlobalUnlock(hMem); GlobalUnlock(hMem);
GlobalFree(hMem); GlobalFree(hMem);
// pData is stale after VBCreateHsz, but we just return the HSZ // pData is stale after VBCreateHsz, but we just return the HSZ
@ -312,6 +415,10 @@ static LONG handleSetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp,
{ {
int16_t val; int16_t val;
dbgInt16("KPCOMCTL: setProp iProp", (int16_t)iProp);
dbgHex16("KPCOMCTL: setProp lp.hi", (uint16_t)(lp >> 16));
dbgHex16("KPCOMCTL: setProp lp.lo", (uint16_t)(lp & 0xFFFF));
switch (iProp) { switch (iProp) {
case IPROP_COMMPORT: case IPROP_COMMPORT:
val = (int16_t)lp; val = (int16_t)lp;
@ -339,7 +446,7 @@ static LONG handleSetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp,
// Save old HSZ, create new one // Save old HSZ, create new one
oldHsz = pData->hszSettings; oldHsz = pData->hszSettings;
newHsz = VBCreateHsz((_segment)0, lpstr); newHsz = VBCreateHsz((HANDLE)0, lpstr);
// pData may be stale after VBCreateHsz - re-deref // pData may be stale after VBCreateHsz - re-deref
pData = DEREF(hctl); pData = DEREF(hctl);
pData->hszSettings = newHsz; pData->hszSettings = newHsz;
@ -479,7 +586,7 @@ static LONG handleSetProperty(HCTL hctl, KpComCtlDataT FAR *pData, USHORT iProp,
lpstr = VBDerefHsz((HSZ)lp); lpstr = VBDerefHsz((HSZ)lp);
oldHsz = pData->hszParityReplace; oldHsz = pData->hszParityReplace;
newHsz = VBCreateHsz((_segment)0, lpstr ? lpstr : ""); newHsz = VBCreateHsz((HANDLE)0, lpstr ? lpstr : "");
// Re-deref after VBCreateHsz // Re-deref after VBCreateHsz
pData = DEREF(hctl); pData = DEREF(hctl);
pData->hszParityReplace = newHsz; pData->hszParityReplace = newHsz;
@ -514,6 +621,8 @@ static void initControlData(HCTL hctl)
KpComCtlDataT FAR *pData; KpComCtlDataT FAR *pData;
HSZ hsz; HSZ hsz;
dbgStr("KPCOMCTL: initControlData\r\n");
pData = DEREF(hctl); pData = DEREF(hctl);
pData->commId = -1; pData->commId = -1;
pData->hwndNotify = NULL; pData->hwndNotify = NULL;
@ -537,11 +646,11 @@ static void initControlData(HCTL hctl)
pData->cdState = FALSE; pData->cdState = FALSE;
// VBCreateHsz may compact VB's heap - re-deref after each call // VBCreateHsz may compact VB's heap - re-deref after each call
hsz = VBCreateHsz((_segment)0, "9600,N,8,1"); hsz = VBCreateHsz((HANDLE)0, "9600,N,8,1");
pData = DEREF(hctl); pData = DEREF(hctl);
pData->hszSettings = hsz; pData->hszSettings = hsz;
hsz = VBCreateHsz((_segment)0, "?"); hsz = VBCreateHsz((HANDLE)0, "?");
pData = DEREF(hctl); pData = DEREF(hctl);
pData->hszParityReplace = hsz; pData->hszParityReplace = hsz;
} }
@ -570,6 +679,10 @@ static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData)
HWND hwndNotify; HWND hwndNotify;
LPSTR lpstr; LPSTR lpstr;
dbgInt16("KPCOMCTL: openPort port", pData->commPort);
dbgInt16("KPCOMCTL: openPort inBuf", pData->inBufferSize);
dbgInt16("KPCOMCTL: openPort outBuf", pData->outBufferSize);
// Snapshot all values we need (pData may become stale after VB API calls) // Snapshot all values we need (pData may become stale after VB API calls)
port = pData->commPort; port = pData->commPort;
inBufSize = pData->inBufferSize; inBufSize = pData->inBufferSize;
@ -586,12 +699,15 @@ static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData)
// Open the comm port // Open the comm port
commId = serialOpen(port, inBufSize, outBufSize); commId = serialOpen(port, inBufSize, outBufSize);
if (commId < 0) { if (commId < 0) {
dbgInt16("KPCOMCTL: openPort serialOpen FAIL", commId);
return -1; return -1;
} }
dbgInt16("KPCOMCTL: openPort commId", commId);
// Configure baud/parity/data/stop // Configure baud/parity/data/stop
lpstr = VBDerefHsz(hszSettings); lpstr = VBDerefHsz(hszSettings);
if (serialConfigure(commId, port, lpstr) != 0) { if (serialConfigure(commId, port, lpstr) != 0) {
dbgStr("KPCOMCTL: openPort configure FAIL\r\n");
serialClose(commId); serialClose(commId);
return -1; return -1;
} }
@ -620,12 +736,13 @@ static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData)
); );
if (hwndNotify == NULL) { if (hwndNotify == NULL) {
dbgStr("KPCOMCTL: openPort CreateWindow FAIL\r\n");
serialClose(commId); serialClose(commId);
return -1; return -1;
} }
// Store HCTL in notification window for message dispatch // Store HCTL in notification window for message dispatch
SetWindowWord(hwndNotify, 0, (WORD)hctl); SetWindowLong(hwndNotify, 0, (LONG)hctl);
// Enable comm notifications // Enable comm notifications
serialEnableNotify(commId, hwndNotify, serialEnableNotify(commId, hwndNotify,
@ -640,6 +757,8 @@ static int16_t openPort(HCTL hctl, KpComCtlDataT FAR *pData)
pData->ctsState = FALSE; pData->ctsState = FALSE;
pData->dsrState = FALSE; pData->dsrState = FALSE;
pData->cdState = FALSE; pData->cdState = FALSE;
dbgStr("KPCOMCTL: openPort OK\r\n");
return 0; return 0;
} }
@ -657,6 +776,7 @@ static void processEventNotify(HCTL hctl, int16_t commId)
UINT evtMask; UINT evtMask;
evtMask = serialGetEventMask(commId, EV_CTS | EV_DSR | EV_RLSD | EV_RING | EV_ERR | EV_BREAK); evtMask = serialGetEventMask(commId, EV_CTS | EV_DSR | EV_RLSD | EV_RING | EV_ERR | EV_BREAK);
dbgHex16("KPCOMCTL: eventNotify mask", (uint16_t)evtMask);
if (evtMask & EV_BREAK) { if (evtMask & EV_BREAK) {
pData = DEREF(hctl); pData = DEREF(hctl);
@ -724,6 +844,8 @@ static void processReceiveNotify(HCTL hctl, int16_t commId)
KpComCtlDataT FAR *pData; KpComCtlDataT FAR *pData;
COMSTAT stat; COMSTAT stat;
dbgStr("KPCOMCTL: receiveNotify\r\n");
pData = DEREF(hctl); pData = DEREF(hctl);
if (pData->rThreshold <= 0) { if (pData->rThreshold <= 0) {
@ -747,6 +869,8 @@ static void processTransmitNotify(HCTL hctl, int16_t commId)
KpComCtlDataT FAR *pData; KpComCtlDataT FAR *pData;
COMSTAT stat; COMSTAT stat;
dbgStr("KPCOMCTL: transmitNotify\r\n");
pData = DEREF(hctl); pData = DEREF(hctl);
if (pData->sThreshold <= 0) { if (pData->sThreshold <= 0) {
@ -764,15 +888,24 @@ static void processTransmitNotify(HCTL hctl, int16_t commId)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// registerNotifyClass - Register hidden notification window class // registerNotifyClass - Register hidden notification window class
//
// Tolerant of already-registered class (VB4 may call VBINITCC multiple
// times without VBTERMCC, or UnregisterClass may fail if windows exist).
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
static BOOL registerNotifyClass(HANDLE hInstance) static BOOL registerNotifyClass(HANDLE hInstance)
{ {
WNDCLASS wc; WNDCLASS wc;
// If class is already registered, treat as success
if (GetClassInfo(hInstance, NOTIFY_CLASS, &wc)) {
dbgStr("KPCOMCTL: notifyClass already registered\r\n");
return TRUE;
}
wc.style = 0; wc.style = 0;
wc.lpfnWndProc = NotifyWndProc; wc.lpfnWndProc = NotifyWndProc;
wc.cbClsExtra = 0; wc.cbClsExtra = 0;
wc.cbWndExtra = sizeof(WORD); // Room for HCTL wc.cbWndExtra = sizeof(LONG); // Room for HCTL (far pointer)
wc.hInstance = hInstance; wc.hInstance = hInstance;
wc.hIcon = NULL; wc.hIcon = NULL;
wc.hCursor = NULL; wc.hCursor = NULL;
@ -800,8 +933,8 @@ LRESULT FAR PASCAL _export NotifyWndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM
int16_t commId; int16_t commId;
UINT notifyCode; UINT notifyCode;
hctl = (HCTL)GetWindowWord(hwnd, 0); hctl = (HCTL)GetWindowLong(hwnd, 0);
if (hctl == 0) { if (hctl == NULL) {
return 0L; return 0L;
} }
@ -814,6 +947,9 @@ LRESULT FAR PASCAL _export NotifyWndProc(HWND hwnd, UINT msg, WPARAM wp, LPARAM
commId = pData->commId; commId = pData->commId;
notifyCode = LOWORD(lp); notifyCode = LOWORD(lp);
dbgInt16("KPCOMCTL: WM_COMMNOTIFY commId", commId);
dbgHex16("KPCOMCTL: WM_COMMNOTIFY code", (uint16_t)notifyCode);
// Each process* function independently derefs and re-derefs as needed // Each process* function independently derefs and re-derefs as needed
if (notifyCode & CN_RECEIVE) { if (notifyCode & CN_RECEIVE) {
processReceiveNotify(hctl, commId); processReceiveNotify(hctl, commId);
@ -842,6 +978,7 @@ LONG FAR PASCAL _export KpComCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp
switch (msg) { switch (msg) {
case VBM_INITIALIZE: case VBM_INITIALIZE:
dbgStr("KPCOMCTL: VBM_INITIALIZE\r\n");
initControlData(hctl); initControlData(hctl);
return 0L; return 0L;
@ -857,6 +994,8 @@ LONG FAR PASCAL _export KpComCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp
HSZ hszSettings; HSZ hszSettings;
HSZ hszParityReplace; HSZ hszParityReplace;
dbgStr("KPCOMCTL: WM_DESTROY\r\n");
pData = DEREF(hctl); pData = DEREF(hctl);
// Close port if open // Close port if open
@ -868,8 +1007,8 @@ LONG FAR PASCAL _export KpComCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp
// VBDestroyHsz may compact the heap, so don't access pData after. // VBDestroyHsz may compact the heap, so don't access pData after.
hszSettings = pData->hszSettings; hszSettings = pData->hszSettings;
hszParityReplace = pData->hszParityReplace; hszParityReplace = pData->hszParityReplace;
pData->hszSettings = 0; pData->hszSettings = NULL;
pData->hszParityReplace = 0; pData->hszParityReplace = NULL;
if (hszSettings) { if (hszSettings) {
VBDestroyHsz(hszSettings); VBDestroyHsz(hszSettings);
@ -894,6 +1033,9 @@ LONG FAR PASCAL _export KpComCtlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
int FAR PASCAL LibMain(HANDLE hInstance, WORD wDataSeg, WORD wHeapSize, LPSTR lpszCmdLine) int FAR PASCAL LibMain(HANDLE hInstance, WORD wDataSeg, WORD wHeapSize, LPSTR lpszCmdLine)
{ {
dbgStr("KPCOMCTL: LibMain\r\n");
dbgHex16("KPCOMCTL: hInstance", (uint16_t)hInstance);
ghInstance = hInstance; ghInstance = hInstance;
if (wHeapSize > 0) { if (wHeapSize > 0) {
@ -909,11 +1051,22 @@ int FAR PASCAL LibMain(HANDLE hInstance, WORD wDataSeg, WORD wHeapSize, LPSTR lp
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
BOOL FAR PASCAL _export VBINITCC(USHORT usVersion, BOOL fRuntime) BOOL FAR PASCAL _export VBINITCC(USHORT usVersion, BOOL fRuntime)
{ {
BOOL rc;
dbgHex16("KPCOMCTL: VBINITCC ver", (uint16_t)usVersion);
dbgInt16("KPCOMCTL: VBINITCC runtime", (int16_t)fRuntime);
dbgInt16("KPCOMCTL: VBINITCC modelInfoCalled", (int16_t)gModelInfoCalled);
if (!registerNotifyClass(ghInstance)) { if (!registerNotifyClass(ghInstance)) {
dbgStr("KPCOMCTL: VBINITCC registerNotifyClass FAILED\r\n");
return FALSE; return FALSE;
} }
dbgStr("KPCOMCTL: VBINITCC notifyClass OK\r\n");
return VBRegisterModel(ghInstance, &modelKpComCtl); rc = VBRegisterModel(ghInstance, &modelKpComCtl);
dbgInt16("KPCOMCTL: VBRegisterModel", (int16_t)rc);
return TRUE;
} }
@ -922,10 +1075,26 @@ BOOL FAR PASCAL _export VBINITCC(USHORT usVersion, BOOL fRuntime)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
void FAR PASCAL _export VBTERMCC(void) void FAR PASCAL _export VBTERMCC(void)
{ {
dbgStr("KPCOMCTL: VBTERMCC\r\n");
dbgInt16("KPCOMCTL: VBTERMCC modelInfoCalled", (int16_t)gModelInfoCalled);
UnregisterClass(NOTIFY_CLASS, ghInstance); UnregisterClass(NOTIFY_CLASS, ghInstance);
} }
// -----------------------------------------------------------------------
// VBGetModelInfo - VB4+ model discovery
//
// Returns a MODELINFO containing a null-terminated list of MODEL pointers.
// VB4 calls this instead of relying on VBRegisterModel in VBINITCC.
// -----------------------------------------------------------------------
LPMODELINFO FAR PASCAL _export VBGetModelInfo(USHORT usVersion)
{
dbgHex16("KPCOMCTL: VBGetModelInfo ver", usVersion);
gModelInfoCalled = TRUE;
return &gModelInfo;
}
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// WEP - DLL termination (required for 16-bit Windows DLLs) // WEP - DLL termination (required for 16-bit Windows DLLs)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------

View file

@ -10,6 +10,7 @@ DATA PRELOAD MOVEABLE SINGLE
HEAPSIZE 1024 HEAPSIZE 1024
EXPORTS EXPORTS
WEP @1 RESIDENTNAME WEP @1 RESIDENTNAME
VBINITCC @2 VBINITCC @2
VBTERMCC @3 VBTERMCC @3
VBGetModelInfo @4

View file

@ -1,7 +1,36 @@
// kpcomctl.rc - KPComCtl VBX resource script // kpcomctl.rc - KPComCtl VBX resource script
// //
// Defines the toolbox bitmap displayed in the VB IDE custom controls palette. // Defines the toolbox bitmap and version information for the VB IDE.
#include "kpcomctl.h" #include "kpcomctl.h"
#include <ver.h>
IDB_KPCOMCTL BITMAP kpcomctl.bmp IDB_KPCOMCTL BITMAP kpcomctl.bmp
VS_VERSION_INFO VERSIONINFO
FILEVERSION 1,0,0,0
PRODUCTVERSION 1,0,0,0
FILEFLAGSMASK VS_FFI_FILEFLAGSMASK
FILEFLAGS 0
FILEOS VOS__WINDOWS16
FILETYPE VFT_DLL
FILESUBTYPE VFT2_UNKNOWN
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904E4"
BEGIN
VALUE "CompanyName", "KP Software\0"
VALUE "FileDescription", "KPComCtl Serial Communications Control\0"
VALUE "FileVersion", "1.00\0"
VALUE "InternalName", "KPCOMCTL\0"
VALUE "OriginalFilename", "KPCOMCTL.VBX\0"
VALUE "ProductName", "KPComCtl\0"
VALUE "ProductVersion", "1.00\0"
END
END
BLOCK "VarFileInfo"
BEGIN
VALUE "Translation", 0x0409, 1252
END
END

View file

@ -5,7 +5,7 @@
# #
# Prerequisites: # Prerequisites:
# - MSVC 1.52 (cl, link, rc in PATH) # - MSVC 1.52 (cl, link, rc in PATH)
# - VBAPI.LIB (from VBX CDK, or generate with: implib vbapi.lib vbapi.def) # - VBAPI.LIB (from VBX CDK - contains thunk stubs, NOT an import library)
# #
# High-speed serial note: # High-speed serial note:
# The stock Windows 3.1 COMM.DRV enables the 16550 FIFO for receive only, # The stock Windows 3.1 COMM.DRV enables the 16550 FIFO for receive only,
@ -32,19 +32,19 @@ RC = rc
# -Ow Safe optimizations for Windows # -Ow Safe optimizations for Windows
# -Zp2 Pack structures on 2-byte boundaries # -Zp2 Pack structures on 2-byte boundaries
# -Ze Enable Microsoft extensions # -Ze Enable Microsoft extensions
CFLAGS = -c -W3 -ASw -Gsw -Ow -Zp2 -Ze CFLAGS = -c -W3 -ASw -Gsw -Ow -Zp2 -Ze -IC:\MSVC\INCLUDE
# Linker flags: # Linker flags:
# /NOD No default libraries # /NOD No default libraries
# /NOE No extended dictionary search # /NOE No extended dictionary search
# /AL:16 Segment alignment 16 # /AL:16 Segment alignment 16
LFLAGS = /NOD /NOE /AL:16 LFLAGS = /NOD /NOE /AL:16 /LI:C:\MSVC\LIB
# Libraries # Libraries
# sdllcew Small model DLL C runtime (emulated math, Windows) # sdllcew Small model DLL C runtime (emulated math, Windows)
# libw Windows API import library # libw Windows API import library
# commdlg Common dialog import library # commdlg Common dialog import library
# vbapi VB API import library # vbapi VB API thunk library (from VBX CDK)
LIBS = sdllcew libw commdlg vbapi LIBS = sdllcew libw commdlg vbapi
# Output # Output
@ -58,7 +58,7 @@ OBJS = kpcomctl.obj serial.obj
# ----------------------------------------------------------------------- # -----------------------------------------------------------------------
all: $(TARGET) all: $(TARGET)
$(TARGET): $(OBJS) kpcomctl.def kpcomctl.res vbapi.lib $(TARGET): $(OBJS) kpcomctl.def kpcomctl.res
$(LINK) $(LFLAGS) $(OBJS), $(TARGET),,$(LIBS), kpcomctl.def $(LINK) $(LFLAGS) $(OBJS), $(TARGET),,$(LIBS), kpcomctl.def
$(RC) kpcomctl.res $(TARGET) $(RC) kpcomctl.res $(TARGET)
@ -69,13 +69,7 @@ serial.obj: serial.c serial.h
$(CC) $(CFLAGS) serial.c $(CC) $(CFLAGS) serial.c
kpcomctl.res: kpcomctl.rc kpcomctl.h kpcomctl.bmp kpcomctl.res: kpcomctl.rc kpcomctl.h kpcomctl.bmp
$(RC) -r kpcomctl.rc $(RC) -r -iC:\MSVC\INCLUDE kpcomctl.rc
# -----------------------------------------------------------------------
# Generate VBAPI.LIB from vbapi.def if not present
# -----------------------------------------------------------------------
vbapi.lib: vbapi.def
implib vbapi.lib vbapi.def
# ----------------------------------------------------------------------- # -----------------------------------------------------------------------
# Clean # Clean

View file

@ -21,9 +21,9 @@
typedef unsigned short USHORT; typedef unsigned short USHORT;
#endif #endif
typedef WORD HCTL; // Handle to a VBX control instance typedef LPVOID HCTL; // Handle to a VBX control instance
typedef WORD HSZ; // Handle to a VB-managed string typedef LPSTR HSZ; // Handle to a VB-managed string
typedef LONG HLSTR; // Handle to a VB long string typedef LPVOID HLSTR; // Handle to a VB long string
typedef USHORT ERR; // Error code typedef USHORT ERR; // Error code
// Flag type // Flag type
@ -35,12 +35,10 @@ typedef DWORD FL;
typedef struct tagMODEL MODEL; typedef struct tagMODEL MODEL;
typedef struct tagPROPINFO PROPINFO; typedef struct tagPROPINFO PROPINFO;
typedef struct tagEVENTINFO EVENTINFO; typedef struct tagEVENTINFO EVENTINFO;
typedef struct tagPARMINFO PARMINFO;
typedef MODEL FAR *LPMODEL; typedef MODEL FAR *LPMODEL;
typedef PROPINFO *PPROPINFO; // Near pointer (DLL data segment) typedef PROPINFO *PPROPINFO; // Near pointer (DLL data segment)
typedef EVENTINFO *PEVENTINFO; // Near pointer (DLL data segment) typedef EVENTINFO *PEVENTINFO; // Near pointer (DLL data segment)
typedef PARMINFO *PPARMINFO; // Near pointer (DLL data segment)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Control procedure type // Control procedure type
@ -81,17 +79,19 @@ typedef LONG (FAR PASCAL *PCTLPROC)(HCTL, HWND, USHORT, USHORT, LONG);
#define PF_fNoRuntimeW 0x00001000L #define PF_fNoRuntimeW 0x00001000L
#define PF_fGetData 0x00002000L #define PF_fGetData 0x00002000L
#define PF_fGetMsg 0x00004000L #define PF_fGetMsg 0x00004000L
#define PF_fGetHszMsg 0x00008000L #define PF_fSetCheck 0x00008000L
#define PF_fUpdateOnEdit 0x00010000L #define PF_fSaveData 0x00010000L
#define PF_fEditable 0x00020000L #define PF_fSaveMsg 0x00020000L
#define PF_fPreHwnd 0x00040000L #define PF_fGetHszMsg 0x00040000L
#define PF_fDefVal 0x00080000L #define PF_fUpdateOnEdit 0x00080000L
#define PF_fNoInitDef 0x00100000L #define PF_fEditable 0x00100000L
#define PF_fNoRuntimeR 0x00200000L #define PF_fPreHwnd 0x00200000L
#define PF_fSaveData 0x00400000L #define PF_fDefVal 0x00400000L
#define PF_fSaveMsg 0x00800000L #define PF_fNoInitDef 0x00800000L
#define PF_fLoadDataOnly 0x01000000L #define PF_fNoRuntimeR 0x02000000L
#define PF_fLoadMsgOnly 0x02000000L #define PF_fNoMultiSelect 0x04000000L
#define PF_fLoadDataOnly 0x20010000L
#define PF_fLoadMsgOnly 0x20020000L
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// MODEL flags // MODEL flags
@ -99,26 +99,27 @@ typedef LONG (FAR PASCAL *PCTLPROC)(HCTL, HWND, USHORT, USHORT, LONG);
#define MODEL_fArrows 0x00000001L #define MODEL_fArrows 0x00000001L
#define MODEL_fFocusOk 0x00000002L #define MODEL_fFocusOk 0x00000002L
#define MODEL_fMnemonic 0x00000004L #define MODEL_fMnemonic 0x00000004L
#define MODEL_fDesInteract 0x00000008L #define MODEL_fChildrenOk 0x00000008L
#define MODEL_fInitMsg 0x00000010L #define MODEL_fInitMsg 0x00000010L
#define MODEL_fLoadMsg 0x00000020L #define MODEL_fLoadMsg 0x00000020L
#define MODEL_fInvisAtRun 0x00000040L #define MODEL_fDesInteract 0x00000040L
#define MODEL_fGraphical 0x00000080L #define MODEL_fInvisAtRun 0x00000080L
#define MODEL_fGraphical 0x00000100L
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// VBX control messages // VBX control messages
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
#define VBM__BASE (WM_USER + 0x0600) #define VBM__BASE (WM_USER + 0x0C00)
#define VBM_INITIALIZE (VBM__BASE + 0) #define VBM_CREATED (VBM__BASE + 0x00)
#define VBM_SETPROPERTY (VBM__BASE + 1) #define VBM_LOADED (VBM__BASE + 0x01)
#define VBM_GETPROPERTY (VBM__BASE + 2) #define VBM_INITIALIZE (VBM__BASE + 0x02)
#define VBM_CHECKPROPERTY (VBM__BASE + 3) #define VBM_GETPROPERTY (VBM__BASE + 0x03)
#define VBM_MNEMONIC (VBM__BASE + 4) #define VBM_CHECKPROPERTY (VBM__BASE + 0x04)
#define VBM_CREATED (VBM__BASE + 5) #define VBM_SETPROPERTY (VBM__BASE + 0x05)
#define VBM_LOADED (VBM__BASE + 6) #define VBM_SAVEPROPERTY (VBM__BASE + 0x06)
#define VBM_SAVEPROPERTY (VBM__BASE + 7) #define VBM_LOADPROPERTY (VBM__BASE + 0x07)
#define VBM_LOADPROPERTY (VBM__BASE + 8) #define VBM_MNEMONIC (VBM__BASE + 0x0D)
#define VBM_METHOD (VBM__BASE + 9) #define VBM_METHOD (VBM__BASE + 0x11)
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Error codes // Error codes
@ -127,28 +128,48 @@ typedef LONG (FAR PASCAL *PCTLPROC)(HCTL, HWND, USHORT, USHORT, LONG);
#define ERR_InvPropVal 380 // Invalid property value #define ERR_InvPropVal 380 // Invalid property value
#define ERR_InvPropSet 383 // Can't set property at this time #define ERR_InvPropSet 383 // Can't set property at this time
// -----------------------------------------------------------------------
// Standard property indices
// -----------------------------------------------------------------------
#define IPROP_STD_NAME 0x0000
#define IPROP_STD_CTLNAME IPROP_STD_NAME
#define IPROP_STD_INDEX 0x0001
#define IPROP_STD_HWND 0x0002
#define IPROP_STD_BACKCOLOR 0x0003
#define IPROP_STD_FORECOLOR 0x0004
#define IPROP_STD_LEFT 0x0005
#define IPROP_STD_TOP 0x0006
#define IPROP_STD_WIDTH 0x0007
#define IPROP_STD_HEIGHT 0x0008
#define IPROP_STD_ENABLED 0x0009
#define IPROP_STD_VISIBLE 0x000A
#define IPROP_STD_PARENT 0x0014
#define IPROP_STD_DRAGMODE 0x0015
#define IPROP_STD_DRAGICON 0x0016
#define IPROP_STD_TAG 0x0019
#define IPROP_STD_NONE 0x001E
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Standard property pointers // Standard property pointers
// //
// Magic values recognized by VB as built-in properties. // Magic sentinel values recognized by VB as built-in properties.
// Uses bitwise NOT of standard property index.
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
#define PPROPINFO_STD_CTLNAME ((PPROPINFO)0) #define PPROPINFO_STD_NAME ((PPROPINFO)~IPROP_STD_NAME)
#define PPROPINFO_STD_INDEX ((PPROPINFO)1) #define PPROPINFO_STD_CTLNAME ((PPROPINFO)~IPROP_STD_CTLNAME)
#define PPROPINFO_STD_HWND ((PPROPINFO)2) #define PPROPINFO_STD_INDEX ((PPROPINFO)~IPROP_STD_INDEX)
#define PPROPINFO_STD_TAG ((PPROPINFO)5) #define PPROPINFO_STD_HWND ((PPROPINFO)~IPROP_STD_HWND)
#define PPROPINFO_STD_LEFT ((PPROPINFO)6) #define PPROPINFO_STD_LEFT ((PPROPINFO)~IPROP_STD_LEFT)
#define PPROPINFO_STD_TOP ((PPROPINFO)7) #define PPROPINFO_STD_TOP ((PPROPINFO)~IPROP_STD_TOP)
#define PPROPINFO_STD_WIDTH ((PPROPINFO)8) #define PPROPINFO_STD_WIDTH ((PPROPINFO)~IPROP_STD_WIDTH)
#define PPROPINFO_STD_HEIGHT ((PPROPINFO)9) #define PPROPINFO_STD_HEIGHT ((PPROPINFO)~IPROP_STD_HEIGHT)
#define PPROPINFO_STD_ENABLED ((PPROPINFO)17) #define PPROPINFO_STD_ENABLED ((PPROPINFO)~IPROP_STD_ENABLED)
#define PPROPINFO_STD_VISIBLE ((PPROPINFO)18) #define PPROPINFO_STD_VISIBLE ((PPROPINFO)~IPROP_STD_VISIBLE)
#define PPROPINFO_STD_PARENT ((PPROPINFO)21) #define PPROPINFO_STD_PARENT ((PPROPINFO)~IPROP_STD_PARENT)
#define PPROPINFO_STD_DRAGMODE ((PPROPINFO)22) #define PPROPINFO_STD_DRAGMODE ((PPROPINFO)~IPROP_STD_DRAGMODE)
#define PPROPINFO_STD_DRAGICON ((PPROPINFO)23) #define PPROPINFO_STD_DRAGICON ((PPROPINFO)~IPROP_STD_DRAGICON)
#define PPROPINFO_STD_NONE ((PPROPINFO)NULL) #define PPROPINFO_STD_TAG ((PPROPINFO)~IPROP_STD_TAG)
#define PPROPINFO_STD_NONE ((PPROPINFO)~IPROP_STD_NONE)
// Aliases matching the plan's naming convention
#define PPROPINFO_STD_NAME PPROPINFO_STD_CTLNAME
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// PROPINFO - Property descriptor // PROPINFO - Property descriptor
@ -163,14 +184,6 @@ struct tagPROPINFO {
BYTE enumMax; // DT_ENUM: maximum valid value BYTE enumMax; // DT_ENUM: maximum valid value
}; };
// -----------------------------------------------------------------------
// PARMINFO - Event parameter descriptor
// -----------------------------------------------------------------------
struct tagPARMINFO {
PSTR npszName; // Parameter name
FL fl; // Data type
};
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// EVENTINFO - Event descriptor // EVENTINFO - Event descriptor
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
@ -178,7 +191,7 @@ struct tagEVENTINFO {
PSTR npszName; // Event name PSTR npszName; // Event name
USHORT cParms; // Number of parameters USHORT cParms; // Number of parameters
USHORT cwParms; // Size of parameters in words USHORT cwParms; // Size of parameters in words
PPARMINFO npParmInfo; // Parameter info array (NULL if no params) PWORD npParmTypes; // Parameter type list (NULL if no params)
PSTR npszParmProf; // Parameter profile string (e.g., "value As Integer") PSTR npszParmProf; // Parameter profile string (e.g., "value As Integer")
FL fl; // Event flags FL fl; // Event flags
}; };
@ -208,6 +221,16 @@ struct tagMODEL {
USHORT usCtlVersion; // Control version (BCD, user-defined) USHORT usCtlVersion; // Control version (BCD, user-defined)
}; };
// -----------------------------------------------------------------------
// MODELINFO - Returned by VBGetModelInfo (VB4+ model discovery)
// -----------------------------------------------------------------------
typedef struct tagMODELINFO {
USHORT usVersion; // VB_VERSION
LPMODEL FAR *lplpmodel; // Null-terminated list of LPMODEL
} MODELINFO;
typedef MODELINFO FAR *LPMODELINFO;
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Utility macro: byte offset of a field within a structure // Utility macro: byte offset of a field within a structure
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
@ -230,25 +253,25 @@ LONG FAR PASCAL VBDefControlProc(HCTL hctl, HWND hwnd, USHORT msg, USHORT wp, LO
ERR FAR PASCAL VBFireEvent(HCTL hctl, USHORT iEvent, LPVOID lpparams); ERR FAR PASCAL VBFireEvent(HCTL hctl, USHORT iEvent, LPVOID lpparams);
// String handle management // String handle management
HSZ FAR PASCAL VBCreateHsz(_segment seg, LPSTR lpsz); HSZ FAR PASCAL VBCreateHsz(HANDLE seg, LPSTR lpsz);
void FAR PASCAL VBDestroyHsz(HSZ hsz); HSZ FAR PASCAL VBDestroyHsz(HSZ hsz);
LPSTR FAR PASCAL VBDerefHsz(HSZ hsz); LPSTR FAR PASCAL VBDerefHsz(HSZ hsz);
// Long string handle management // Long string handle management
HLSTR FAR PASCAL VBCreateHlstr(LPVOID lpdata, USHORT cbLen); HLSTR FAR PASCAL VBCreateHlstr(LPVOID lpdata, USHORT cbLen);
void FAR PASCAL VBDestroyHlstr(HLSTR hlstr); void FAR PASCAL VBDestroyHlstr(HLSTR hlstr);
LPSTR FAR PASCAL VBGetHlstr(HLSTR hlstr, USHORT FAR *lpcbLen); USHORT FAR PASCAL VBGetHlstr(HLSTR hlstr, LPVOID pb, USHORT cbLen);
ERR FAR PASCAL VBSetHlstr(HLSTR FAR *phlstr, LPVOID lpdata, USHORT cbLen); ERR FAR PASCAL VBSetHlstr(HLSTR FAR *phlstr, LPVOID lpdata, USHORT cbLen);
// Control data access // Control data access
LPVOID FAR PASCAL VBDerefControl(HCTL hctl); LPVOID FAR PASCAL VBDerefControl(HCTL hctl);
// Runtime mode query (TRUE = runtime, FALSE = design) // Runtime mode query (MODE_DESIGN=1, MODE_RUN=2, MODE_BREAK=3)
BOOL FAR PASCAL VBGetMode(void); USHORT FAR PASCAL VBGetMode(void);
// Control property access // Control property access
ERR FAR PASCAL VBSetControlProperty(HCTL hctl, USHORT iProp, LONG data); ERR FAR PASCAL VBSetControlProperty(HCTL hctl, USHORT iProp, LONG data);
LONG FAR PASCAL VBGetControlProperty(HCTL hctl, USHORT iProp); ERR FAR PASCAL VBGetControlProperty(HCTL hctl, USHORT iProp, LPVOID pdata);
// Control window handle // Control window handle
HWND FAR PASCAL VBGetControlHwnd(HCTL hctl); HWND FAR PASCAL VBGetControlHwnd(HCTL hctl);
@ -256,6 +279,9 @@ HWND FAR PASCAL VBGetControlHwnd(HCTL hctl);
// Instance handle // Instance handle
HANDLE FAR PASCAL VBGetHInstance(void); HANDLE FAR PASCAL VBGetHInstance(void);
// Runtime version
USHORT FAR PASCAL VBGetVersion(void);
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------
// Restore default packing // Restore default packing
// ----------------------------------------------------------------------- // -----------------------------------------------------------------------