<BLOCKQUOTE><font size="1" face="Arial, Verdana">code:</font><HR><pre>
/* rem definitions for windows API calls, variables */
&SCOPED-DEFINE DWORD LONG
define var OPEN_EXISTING as integer initial 3.
define var READ_WRITE as integer initial -1073741824.
define var bit-flags as integer.
DEFINE VARIABLE lRC AS LOGICAL NO-UNDO.
DEFINE VARIABLE CommunicationsActive AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE VARIABLE nRC AS INTEGER NO-UNDO.
DEFINE VARIABLE CommHandle AS INTEGER NO-UNDO.
DEFINE VARIABLE RCount AS INTEGER NO-UNDO.
DEFINE VARIABLE TCount AS INTEGER NO-UNDO.
DEFINE VARIABLE DCBStructurePointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE ComStatStructurePointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE ReceiveDataPointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE TransmitDataPointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE DCBStructure AS CHARACTER NO-UNDO FORMAT "X(28)".
DEFINE VARIABLE ComStatStructure AS CHARACTER NO-UNDO FORMAT "X(5)".
DEFINE VARIABLE ReceiveData AS CHARACTER NO-UNDO FORMAT "X(1024)".
DEFINE VARIABLE TransmitData AS CHARACTER NO-UNDO FORMAT "X(1024)".
/* Windows API Procedure Definitions --- */
PROCEDURE ClearCommError EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT-OUTPUT PARAMETER errormask AS MEMPTR NO-UNDO. /* POINTER TO STATUS DATA */
DEFINE INPUT-OUTPUT PARAMETER comstat AS MEMPTR NO-UNDO. /* POINTER TO STATUS DATA */
/*DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. */
END PROCEDURE.
PROCEDURE CreateFileA EXTERNAL "kernel32.DLL":
DEFINE INPUT PARAMETER szDevice AS CHARACTER NO-UNDO. /* DEVICE NAME */
DEFINE INPUT PARAMETER fdwAccess AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER fdwShareMode AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER lpsa AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER fdwCreate AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER fdwAttrFlags AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER hTemplate AS {&DWORD} NO-UNDO.
DEFINE RETURN PARAMETER nCid AS {&DWORD} NO-UNDO.
END PROCEDURE.
PROCEDURE CloseHandle EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
END PROCEDURE.
PROCEDURE GetCommState EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* CONFIG STRING IN DOS MODE FORMAT */
DEFINE INPUT-OUTPUT PARAMETER lpDCB AS MEMPTR NO-UNDO. /* POINTER TO A DCB STRUCTURE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE FlushComm EXTERNAL "USER.EXE":
DEFINE INPUT PARAMETER nCid AS SHORT NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT PARAMETER nQueue AS SHORT NO-UNDO. /* WHICH BUFFER TO FLUSH */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE SetCommState EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* POINTER TO A DCB STRUCTURE */
DEFINE INPUT-OUTPUT PARAMETER lpDCB AS MEMPTR NO-UNDO. /* POINTER TO A DCB STRUCTURE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE ReadFile EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT-OUTPUT PARAMETER lpBuf AS MEMPTR NO-UNDO. /* POINTER TO A RECEIVE BUFFER */
DEFINE INPUT PARAMETER nSizetoRead AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE INPUT-OUTPUT PARAMETER nSizeActRead AS MEMPTR NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE INPUT PARAMETER nullptr AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE WriteFile EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT-output PARAMETER lpBuf AS MEMPTR NO-UNDO. /* POINTER TO A TRANSMIT BUFFER */
DEFINE INPUT PARAMETER nSizetowrite AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO TRANSMIT */
DEFINE INPUT-OUTPUT PARAMETER nSizeActwrit AS MEMPTR NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE INPUT PARAMETER nullptr AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
/* internal procedure calls*/
PROCEDURE OpenCommunications :
RUN CreateFileA (tnet_ref.com_port,READ_WRITE,0,0,OPEN_EXISTING,0,0, OUTPUT CommHandle).
IF CommHandle <0 THEN
do:
message "Invalid comm handle:" CommHandle " in OpenCommunications" view-as alert-box error.
quit.
end.
SET-SIZE(DCBStructurePointer) = 29.
RUN GetCommState (CommHandle, INPUT-OUTPUT DCBStructurePointer, OUTPUT nRC).
IF nRC <>0 THEN
do:
ASSIGN DCBStructure = GET-STRING(DCBStructurePointer,1).
put-long(DCBStructurePointer,5)=9600.
bit-flags=exp(2,9) + exp(2,10).
put-long(DCBStructurePointer,9)=bit-flags.
put-byte(DCBStructurePointer,19)=8.
put-byte(DCBStructurePointer,20)=0.
RUN SetCommState (CommHandle, INPUT-OUTPUT DCBStructurePointer,
OUTPUT nRC).
if nRC=0
then
do:
message "error setting new parameters" view-as alert-box.
end.
end.
ELSE
do:
message "BuildCommDCB failed in OpenCommunications" view-as alert-box error.
end.
END PROCEDURE.
PROCEDURE ReceiveData :
define input parameter numchars as int.
define var xxx as memptr.
/* The ReceiveData Variable Will Contain The Data Read From The Serial Port */
set-size(xxx)=4.
if numchars>0
then
do:
SET-SIZE(ReceiveDataPointer) = numchars + 1. /* Max Size of Receive Queue */
RUN ReadFile (CommHandle, INPUT-OUTPUT ReceiveDataPointer,
numchars,INPUT-OUTPUT xxx,0, OUTPUT nRC).
ASSIGN ReceiveData = GET-STRING(ReceiveDataPointer,1).
if numchars < get-long(xxx,1)
THEN
DO:
message "Readcomm did not get all characters".
END.
SET-SIZE(ReceiveDataPointer) = 0.
end.
set-size(xxx)=0.
END PROCEDURE.
procedure check-receive:
define var errmask as memptr.
define var xxx as memptr.
define var num-chars as int.
set-size(xxx)=12.
set-size(errmask)=4.
put-long(xxx,1)=0.
put-long(errmask,1)=0.
run ClearCommError(commhandle,input-output errmask,input-output xxx /*,output nrc*/).
num-chars=get-long(xxx,5).
set-size(errmask)=0.
set-size(xxx)=0.
return string(num-chars).
end procedure.
PROCEDURE TransmitData :
define input parameter datatosend as char.
DEFINE VARIABLE TotalSize AS INTEGER NO-UNDO.
define var xxx as memptr.
define var retry-count as int initial 0.
set-size(xxx)=4.
put-long(xxx,1)=0.
do while length(datatosend)>0:
ASSIGN TransmitData = DataToSend
TotalSize = LENGTH(TransmitData).
SET-SIZE(TransmitDataPointer) = TotalSize + 1.
PUT-STRING(TransmitDataPointer,1) = TransmitData.
RUN WriteFile (CommHandle,input-output TransmitDataPointer, TotalSize
,input-output xxx,0, OUTPUT nRC).
CASE TRUE:
WHEN get-long(xxx,1) LT TotalSize THEN
DO:
message "transmitdata sent " nrc " of " totalsize
" at " time "retry=" retry-count.
assign retry-count=retry-count + 1 .
datatosend=substring( transmitdata ,
absolute(nRC) + 1 ).
pause 1 no-message.
END.
OTHERWISE
DO:
datatosend="".
END.
END CASE.
set-size(TransmitDataPointer) = 0.
end.
set-size(xxx)=0.
END PROCEDURE.
[/code]
/* rem definitions for windows API calls, variables */
&SCOPED-DEFINE DWORD LONG
define var OPEN_EXISTING as integer initial 3.
define var READ_WRITE as integer initial -1073741824.
define var bit-flags as integer.
DEFINE VARIABLE lRC AS LOGICAL NO-UNDO.
DEFINE VARIABLE CommunicationsActive AS LOGICAL NO-UNDO INITIAL FALSE.
DEFINE VARIABLE nRC AS INTEGER NO-UNDO.
DEFINE VARIABLE CommHandle AS INTEGER NO-UNDO.
DEFINE VARIABLE RCount AS INTEGER NO-UNDO.
DEFINE VARIABLE TCount AS INTEGER NO-UNDO.
DEFINE VARIABLE DCBStructurePointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE ComStatStructurePointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE ReceiveDataPointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE TransmitDataPointer AS MEMPTR NO-UNDO.
DEFINE VARIABLE DCBStructure AS CHARACTER NO-UNDO FORMAT "X(28)".
DEFINE VARIABLE ComStatStructure AS CHARACTER NO-UNDO FORMAT "X(5)".
DEFINE VARIABLE ReceiveData AS CHARACTER NO-UNDO FORMAT "X(1024)".
DEFINE VARIABLE TransmitData AS CHARACTER NO-UNDO FORMAT "X(1024)".
/* Windows API Procedure Definitions --- */
PROCEDURE ClearCommError EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT-OUTPUT PARAMETER errormask AS MEMPTR NO-UNDO. /* POINTER TO STATUS DATA */
DEFINE INPUT-OUTPUT PARAMETER comstat AS MEMPTR NO-UNDO. /* POINTER TO STATUS DATA */
/*DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. */
END PROCEDURE.
PROCEDURE CreateFileA EXTERNAL "kernel32.DLL":
DEFINE INPUT PARAMETER szDevice AS CHARACTER NO-UNDO. /* DEVICE NAME */
DEFINE INPUT PARAMETER fdwAccess AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER fdwShareMode AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER lpsa AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER fdwCreate AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER fdwAttrFlags AS {&DWORD} NO-UNDO.
DEFINE INPUT PARAMETER hTemplate AS {&DWORD} NO-UNDO.
DEFINE RETURN PARAMETER nCid AS {&DWORD} NO-UNDO.
END PROCEDURE.
PROCEDURE CloseHandle EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
END PROCEDURE.
PROCEDURE GetCommState EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* CONFIG STRING IN DOS MODE FORMAT */
DEFINE INPUT-OUTPUT PARAMETER lpDCB AS MEMPTR NO-UNDO. /* POINTER TO A DCB STRUCTURE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE FlushComm EXTERNAL "USER.EXE":
DEFINE INPUT PARAMETER nCid AS SHORT NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT PARAMETER nQueue AS SHORT NO-UNDO. /* WHICH BUFFER TO FLUSH */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE SetCommState EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* POINTER TO A DCB STRUCTURE */
DEFINE INPUT-OUTPUT PARAMETER lpDCB AS MEMPTR NO-UNDO. /* POINTER TO A DCB STRUCTURE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE ReadFile EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT-OUTPUT PARAMETER lpBuf AS MEMPTR NO-UNDO. /* POINTER TO A RECEIVE BUFFER */
DEFINE INPUT PARAMETER nSizetoRead AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE INPUT-OUTPUT PARAMETER nSizeActRead AS MEMPTR NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE INPUT PARAMETER nullptr AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
PROCEDURE WriteFile EXTERNAL "KERNEL32.DLL":
DEFINE INPUT PARAMETER nCid AS {&DWORD} NO-UNDO. /* COMMUNICATIONS HANDLE */
DEFINE INPUT-output PARAMETER lpBuf AS MEMPTR NO-UNDO. /* POINTER TO A TRANSMIT BUFFER */
DEFINE INPUT PARAMETER nSizetowrite AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO TRANSMIT */
DEFINE INPUT-OUTPUT PARAMETER nSizeActwrit AS MEMPTR NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE INPUT PARAMETER nullptr AS {&DWORD} NO-UNDO. /* NUMBER OF BYTES TO RECEIVE */
DEFINE RETURN PARAMETER nReturn AS SHORT NO-UNDO. /* RETURN CODE */
END PROCEDURE.
/* internal procedure calls*/
PROCEDURE OpenCommunications :
RUN CreateFileA (tnet_ref.com_port,READ_WRITE,0,0,OPEN_EXISTING,0,0, OUTPUT CommHandle).
IF CommHandle <0 THEN
do:
message "Invalid comm handle:" CommHandle " in OpenCommunications" view-as alert-box error.
quit.
end.
SET-SIZE(DCBStructurePointer) = 29.
RUN GetCommState (CommHandle, INPUT-OUTPUT DCBStructurePointer, OUTPUT nRC).
IF nRC <>0 THEN
do:
ASSIGN DCBStructure = GET-STRING(DCBStructurePointer,1).
put-long(DCBStructurePointer,5)=9600.
bit-flags=exp(2,9) + exp(2,10).
put-long(DCBStructurePointer,9)=bit-flags.
put-byte(DCBStructurePointer,19)=8.
put-byte(DCBStructurePointer,20)=0.
RUN SetCommState (CommHandle, INPUT-OUTPUT DCBStructurePointer,
OUTPUT nRC).
if nRC=0
then
do:
message "error setting new parameters" view-as alert-box.
end.
end.
ELSE
do:
message "BuildCommDCB failed in OpenCommunications" view-as alert-box error.
end.
END PROCEDURE.
PROCEDURE ReceiveData :
define input parameter numchars as int.
define var xxx as memptr.
/* The ReceiveData Variable Will Contain The Data Read From The Serial Port */
set-size(xxx)=4.
if numchars>0
then
do:
SET-SIZE(ReceiveDataPointer) = numchars + 1. /* Max Size of Receive Queue */
RUN ReadFile (CommHandle, INPUT-OUTPUT ReceiveDataPointer,
numchars,INPUT-OUTPUT xxx,0, OUTPUT nRC).
ASSIGN ReceiveData = GET-STRING(ReceiveDataPointer,1).
if numchars < get-long(xxx,1)
THEN
DO:
message "Readcomm did not get all characters".
END.
SET-SIZE(ReceiveDataPointer) = 0.
end.
set-size(xxx)=0.
END PROCEDURE.
procedure check-receive:
define var errmask as memptr.
define var xxx as memptr.
define var num-chars as int.
set-size(xxx)=12.
set-size(errmask)=4.
put-long(xxx,1)=0.
put-long(errmask,1)=0.
run ClearCommError(commhandle,input-output errmask,input-output xxx /*,output nrc*/).
num-chars=get-long(xxx,5).
set-size(errmask)=0.
set-size(xxx)=0.
return string(num-chars).
end procedure.
PROCEDURE TransmitData :
define input parameter datatosend as char.
DEFINE VARIABLE TotalSize AS INTEGER NO-UNDO.
define var xxx as memptr.
define var retry-count as int initial 0.
set-size(xxx)=4.
put-long(xxx,1)=0.
do while length(datatosend)>0:
ASSIGN TransmitData = DataToSend
TotalSize = LENGTH(TransmitData).
SET-SIZE(TransmitDataPointer) = TotalSize + 1.
PUT-STRING(TransmitDataPointer,1) = TransmitData.
RUN WriteFile (CommHandle,input-output TransmitDataPointer, TotalSize
,input-output xxx,0, OUTPUT nRC).
CASE TRUE:
WHEN get-long(xxx,1) LT TotalSize THEN
DO:
message "transmitdata sent " nrc " of " totalsize
" at " time "retry=" retry-count.
assign retry-count=retry-count + 1 .
datatosend=substring( transmitdata ,
absolute(nRC) + 1 ).
pause 1 no-message.
END.
OTHERWISE
DO:
datatosend="".
END.
END CASE.
set-size(TransmitDataPointer) = 0.
end.
set-size(xxx)=0.
END PROCEDURE.
[/code]