Reorganized and got BP compiling
This commit is contained in:
parent
6923bf0c27
commit
24b63b3b6a
|
@ -1,22 +0,0 @@
|
||||||
# Auto detect text files and perform LF normalization
|
|
||||||
* text=auto
|
|
||||||
|
|
||||||
# Custom for Visual Studio
|
|
||||||
*.cs diff=csharp
|
|
||||||
*.sln merge=union
|
|
||||||
*.csproj merge=union
|
|
||||||
*.vbproj merge=union
|
|
||||||
*.fsproj merge=union
|
|
||||||
*.dbproj merge=union
|
|
||||||
|
|
||||||
# Standard to msysgit
|
|
||||||
*.doc diff=astextplain
|
|
||||||
*.DOC diff=astextplain
|
|
||||||
*.docx diff=astextplain
|
|
||||||
*.DOCX diff=astextplain
|
|
||||||
*.dot diff=astextplain
|
|
||||||
*.DOT diff=astextplain
|
|
||||||
*.pdf diff=astextplain
|
|
||||||
*.PDF diff=astextplain
|
|
||||||
*.rtf diff=astextplain
|
|
||||||
*.RTF diff=astextplain
|
|
|
@ -1,163 +1,2 @@
|
||||||
#################
|
EXE/
|
||||||
## Eclipse
|
ORIGINAL ARCHIVES/
|
||||||
#################
|
|
||||||
|
|
||||||
*.pydevproject
|
|
||||||
.project
|
|
||||||
.metadata
|
|
||||||
bin/
|
|
||||||
tmp/
|
|
||||||
*.tmp
|
|
||||||
*.bak
|
|
||||||
*.swp
|
|
||||||
*~.nib
|
|
||||||
local.properties
|
|
||||||
.classpath
|
|
||||||
.settings/
|
|
||||||
.loadpath
|
|
||||||
|
|
||||||
# External tool builders
|
|
||||||
.externalToolBuilders/
|
|
||||||
|
|
||||||
# Locally stored "Eclipse launch configurations"
|
|
||||||
*.launch
|
|
||||||
|
|
||||||
# CDT-specific
|
|
||||||
.cproject
|
|
||||||
|
|
||||||
# PDT-specific
|
|
||||||
.buildpath
|
|
||||||
|
|
||||||
|
|
||||||
#################
|
|
||||||
## Visual Studio
|
|
||||||
#################
|
|
||||||
|
|
||||||
## Ignore Visual Studio temporary files, build results, and
|
|
||||||
## files generated by popular Visual Studio add-ons.
|
|
||||||
|
|
||||||
# User-specific files
|
|
||||||
*.suo
|
|
||||||
*.user
|
|
||||||
*.sln.docstates
|
|
||||||
|
|
||||||
# Build results
|
|
||||||
[Dd]ebug/
|
|
||||||
[Rr]elease/
|
|
||||||
*_i.c
|
|
||||||
*_p.c
|
|
||||||
*.ilk
|
|
||||||
*.meta
|
|
||||||
*.obj
|
|
||||||
*.pch
|
|
||||||
*.pdb
|
|
||||||
*.pgc
|
|
||||||
*.pgd
|
|
||||||
*.rsp
|
|
||||||
*.sbr
|
|
||||||
*.tlb
|
|
||||||
*.tli
|
|
||||||
*.tlh
|
|
||||||
*.tmp
|
|
||||||
*.vspscc
|
|
||||||
.builds
|
|
||||||
*.dotCover
|
|
||||||
|
|
||||||
## TODO: If you have NuGet Package Restore enabled, uncomment this
|
|
||||||
#packages/
|
|
||||||
|
|
||||||
# Visual C++ cache files
|
|
||||||
ipch/
|
|
||||||
*.aps
|
|
||||||
*.ncb
|
|
||||||
*.opensdf
|
|
||||||
*.sdf
|
|
||||||
|
|
||||||
# Visual Studio profiler
|
|
||||||
*.psess
|
|
||||||
*.vsp
|
|
||||||
|
|
||||||
# ReSharper is a .NET coding add-in
|
|
||||||
_ReSharper*
|
|
||||||
|
|
||||||
# Installshield output folder
|
|
||||||
[Ee]xpress
|
|
||||||
|
|
||||||
# DocProject is a documentation generator add-in
|
|
||||||
DocProject/buildhelp/
|
|
||||||
DocProject/Help/*.HxT
|
|
||||||
DocProject/Help/*.HxC
|
|
||||||
DocProject/Help/*.hhc
|
|
||||||
DocProject/Help/*.hhk
|
|
||||||
DocProject/Help/*.hhp
|
|
||||||
DocProject/Help/Html2
|
|
||||||
DocProject/Help/html
|
|
||||||
|
|
||||||
# Click-Once directory
|
|
||||||
publish
|
|
||||||
|
|
||||||
# Others
|
|
||||||
[Bb]in
|
|
||||||
[Oo]bj
|
|
||||||
sql
|
|
||||||
TestResults
|
|
||||||
*.Cache
|
|
||||||
ClientBin
|
|
||||||
stylecop.*
|
|
||||||
~$*
|
|
||||||
*.dbmdl
|
|
||||||
Generated_Code #added for RIA/Silverlight projects
|
|
||||||
|
|
||||||
# Backup & report files from converting an old project file to a newer
|
|
||||||
# Visual Studio version. Backup files are not needed, because we have git ;-)
|
|
||||||
_UpgradeReport_Files/
|
|
||||||
Backup*/
|
|
||||||
UpgradeLog*.XML
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
############
|
|
||||||
## Windows
|
|
||||||
############
|
|
||||||
|
|
||||||
# Windows image file caches
|
|
||||||
Thumbs.db
|
|
||||||
|
|
||||||
# Folder config file
|
|
||||||
Desktop.ini
|
|
||||||
|
|
||||||
|
|
||||||
#############
|
|
||||||
## Python
|
|
||||||
#############
|
|
||||||
|
|
||||||
*.py[co]
|
|
||||||
|
|
||||||
# Packages
|
|
||||||
*.egg
|
|
||||||
*.egg-info
|
|
||||||
dist
|
|
||||||
build
|
|
||||||
eggs
|
|
||||||
parts
|
|
||||||
bin
|
|
||||||
var
|
|
||||||
sdist
|
|
||||||
develop-eggs
|
|
||||||
.installed.cfg
|
|
||||||
|
|
||||||
# Installer logs
|
|
||||||
pip-log.txt
|
|
||||||
|
|
||||||
# Unit test / coverage reports
|
|
||||||
.coverage
|
|
||||||
.tox
|
|
||||||
|
|
||||||
#Translations
|
|
||||||
*.mo
|
|
||||||
|
|
||||||
#Mr Developer
|
|
||||||
.mr.developer.cfg
|
|
||||||
|
|
||||||
# Mac crap
|
|
||||||
.DS_Store
|
|
|
@ -0,0 +1,27 @@
|
||||||
|
/EZ:\PROGRA~1\RG119SRC\EXE\BP
|
||||||
|
/IZ:\BP\UNITS;
|
||||||
|
/OZ:\BP\UNITS;
|
||||||
|
/UZ:\BP\UNITS;
|
||||||
|
/R
|
||||||
|
/$MD64000,0,655360
|
||||||
|
/$MP64000
|
||||||
|
/$A+
|
||||||
|
/$B-
|
||||||
|
/$D+
|
||||||
|
/$E+
|
||||||
|
/$F+
|
||||||
|
/$G+
|
||||||
|
/$I-
|
||||||
|
/$L+
|
||||||
|
/$N-
|
||||||
|
/$O+
|
||||||
|
/$P-
|
||||||
|
/$Q-
|
||||||
|
/$R-
|
||||||
|
/$S-
|
||||||
|
/$T-
|
||||||
|
/$V-
|
||||||
|
/$X+
|
||||||
|
/$Y+
|
||||||
|
/B
|
||||||
|
/GD
|
|
@ -0,0 +1,63 @@
|
||||||
|
@ECHO OFF
|
||||||
|
|
||||||
|
Z:
|
||||||
|
|
||||||
|
ECHO CLEAING UP OUTPUT DIRECTORY
|
||||||
|
DEL /Q Z:\PROGRAMMING\RG119SRC\EXE\BP\*.*
|
||||||
|
|
||||||
|
ECHO COPYING BPC.CFG TO BP DIRECTORY
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\BPC.CFG Z:\BP\BIN
|
||||||
|
|
||||||
|
CD Z:\PROGRAMMING\RG119SRC\SOURCE
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RENEGADE.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RENEGADE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RENEMAIL.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RENEMAIL.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGLNG.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RGLNG.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGMAIN.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RGMAIN.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGNOTE.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RGNOTE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGQUOTE.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RGQUOTE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGSCFG.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE RGSCFG.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING TAGLINE.EXE
|
||||||
|
Z:\BP\BIN\BPC.EXE TAGLINE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
:COPY
|
||||||
|
ECHO.
|
||||||
|
ECHO BUILD COMPLETE! HIT A KEY TO COPY EXE FILES OR CTRL-C TO SKIP
|
||||||
|
PAUSE
|
||||||
|
|
||||||
|
CD Z:\PROGRAMMING\RG119SRC
|
||||||
|
CALL COPYEXEBP
|
||||||
|
GOTO END
|
||||||
|
|
||||||
|
:END
|
||||||
|
PAUSE
|
|
@ -0,0 +1,63 @@
|
||||||
|
@ECHO OFF
|
||||||
|
|
||||||
|
Z:
|
||||||
|
|
||||||
|
ECHO CLEAING UP OUTPUT DIRECTORY
|
||||||
|
DEL /Q Z:\PROGRAMMING\RG119SRC\EXE\VP\*.*
|
||||||
|
|
||||||
|
ECHO COPYING VPC.CFG TO VP21 DIRECTORY
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\VPC.CFG Z:\VP21\BIN.W32
|
||||||
|
|
||||||
|
CD Z:\PROGRAMMING\RG119SRC\SOURCE
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RENEGADE.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RENEGADE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RENEMAIL.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RENEMAIL.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGLNG.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RGLNG.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGMAIN.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RGMAIN.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGNOTE.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RGNOTE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGQUOTE.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RGQUOTE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING RGSCFG.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC RGSCFG.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
ECHO.
|
||||||
|
ECHO COMPILING TAGLINE.EXE
|
||||||
|
Z:\VP21\BIN.W32\VPC TAGLINE.PAS
|
||||||
|
IF NOT %ERRORLEVEL% == 0 GOTO END
|
||||||
|
|
||||||
|
:COPY
|
||||||
|
ECHO.
|
||||||
|
ECHO BUILD COMPLETE! HIT A KEY TO COPY EXE FILES OR CTRL-C TO SKIP
|
||||||
|
PAUSE
|
||||||
|
|
||||||
|
CD Z:\PROGRAMMING\RG119SRC
|
||||||
|
CALL COPYEXEVP
|
||||||
|
GOTO END
|
||||||
|
|
||||||
|
:END
|
||||||
|
PAUSE
|
|
@ -0,0 +1,55 @@
|
||||||
|
Step 0) Assumptions:
|
||||||
|
|
||||||
|
The first assumption is that you have Borland Pascal installed in Z:\BP.
|
||||||
|
If you don't, you'll have to update the BUILDBP.CMD file
|
||||||
|
|
||||||
|
The second assumption is that you have Virtual Pascal installed in Z:\vp21.
|
||||||
|
If you don't, you'll have to update the BUILDVP.CMD file
|
||||||
|
|
||||||
|
*NOTE* The BUILD*.CMD files will copy a BPC.CFG or VPC.CFG into the relevant bin directory, meaning
|
||||||
|
if you have cusomized the .CFG file in the bin directory, it will be lost. Make a backup!
|
||||||
|
|
||||||
|
Step 1) Create directories to hold everything:
|
||||||
|
|
||||||
|
Z:\RG119
|
||||||
|
Z:\Programming\RG119SRC
|
||||||
|
Z:\Programming\RG119SRC\EXE\BP
|
||||||
|
Z:\Programming\RG119SRC\EXE\VP
|
||||||
|
|
||||||
|
If you don't have a Z: drive, you can use SUBST or map a network drive to fake one
|
||||||
|
You can also put the files in an alternate location if you want, you'll just have to update the BUILD*.CMD scripts
|
||||||
|
|
||||||
|
Step 2) Get the source
|
||||||
|
|
||||||
|
Check out the GIT contents into Z:\Programming\RG119SRC
|
||||||
|
|
||||||
|
Step 3) Edit Z:\vp21\source\rtl\vpsysw32.pas
|
||||||
|
|
||||||
|
For some reason the cursor position isn't always updated in the background thread in the Win32 version. I'm guessing
|
||||||
|
it's a race condition with the CurXPos and CurYPos variables, so the thread doesn't think an update is needed when
|
||||||
|
one really is. So I've updated my copy of CursorThreadFunc to take the return value of the SemWaitEvent() call into
|
||||||
|
account, so the update will also happen if the event is signaled. Can't think of a reason why they wouldn't have done
|
||||||
|
this in the first place. Here's the entire function to copy/paste into place:
|
||||||
|
|
||||||
|
function CursorThreadFunc(P: Pointer): Longint;
|
||||||
|
var
|
||||||
|
LastX, LastY: Longint;
|
||||||
|
begin
|
||||||
|
LastX := -1;
|
||||||
|
LastY := -1;
|
||||||
|
repeat
|
||||||
|
if SemWaitEvent(semCursor, 300) or (CurXPos <> LastX) or (CurYPos <> LastY) then
|
||||||
|
begin
|
||||||
|
DoSetCursorPosition;
|
||||||
|
LastX := CurXPos;
|
||||||
|
LastY := CurYPos;
|
||||||
|
end;
|
||||||
|
until tidCursor = -2;
|
||||||
|
tidCursor := -1;
|
||||||
|
end;
|
||||||
|
|
||||||
|
Step 4) Build new EXEs
|
||||||
|
|
||||||
|
Run BUILDBP.CMD to build the DOS EXEs and have them copied to Z:\RG119
|
||||||
|
|
||||||
|
Run BUILDVP.CMD to build the WIN32 EXEs and have them copied to Z:\RG119
|
|
@ -0,0 +1,10 @@
|
||||||
|
@ECHO OFF
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RENEGADE.EXE Z:\RG119\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RENEGADE.OVR Z:\RG119\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RENEMAIL.EXE Z:\RG119\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGLNG.EXE Z:\RG119\DATA\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGMAIN.EXE Z:\RG119\DATA\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGNOTE.EXE Z:\RG119\DATA\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGQUOTE.EXE Z:\RG119\DATA\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\RGSCFG.EXE Z:\RG119\DATA\
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\BP\TAGLINE.EXE Z:\RG119\DATA\
|
|
@ -0,0 +1,9 @@
|
||||||
|
@ECHO OFF
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RENEGADE.EXE Z:\RG119\RENEGADE32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RENEMAIL.EXE Z:\RG119\RENEMAIL32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGLNG.EXE Z:\RG119\DATA\RGLNG32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGMAIN.EXE Z:\RG119\DATA\RGMAIN32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGNOTE.EXE Z:\RG119\DATA\RGNOTE32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGQUOTE.EXE Z:\RG119\DATA\RGQUOTE32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\RGSCFG.EXE Z:\RG119\DATA\RGSCFG32.EXE
|
||||||
|
COPY Z:\PROGRAMMING\RG119SRC\EXE\VP\TAGLINE.EXE Z:\RG119\DATA\TAGLINE32.EXE
|
|
@ -0,0 +1,30 @@
|
||||||
|
Renegade v1.19
|
||||||
|
==============
|
||||||
|
|
||||||
|
This is a port of the current version of Renegade: v1.19. My port of the older Y2Ka2 version can be found here: https://github.com/rickparrish/Renegade<br />
|
||||||
|
<br />
|
||||||
|
This is a fork of the official v1.19 release, which can be found here: https://github.com/Renegade-Exodus/RG119SRC<br />
|
||||||
|
|
||||||
|
==============================
|
||||||
|
Copyright Cott Lang, Patrick Spence, Gary Hall, Jeff Herrings, T.J. McMillen, Chris Hoppman, and Lee Palmer<br />
|
||||||
|
Ported to Win32 by Rick Parrish<br />
|
||||||
|
|
||||||
|
<hr />
|
||||||
|
|
||||||
|
TODO list:<br />
|
||||||
|
<ul>
|
||||||
|
<li>IFDEF out anything that doesn't compile and make a WIN32 placeholder that does a "WriteLn('REETODO UNIT FUNCTION'); Halt;" (then you can grep the executables for REETODO to see which REETODOs actually need to be implemented)</li>
|
||||||
|
<li>IFDEF out any ASM code blocks and handle the same as above</li>
|
||||||
|
<li>WORD in RECORD to SMALLWORD</li>
|
||||||
|
<li>INTEGER in RECORD to SMALLINT</li>
|
||||||
|
<li>TYPEs of OF WORD to OF SMALLWORD (just in case they're used in a RECORD)</li>
|
||||||
|
<li>TYPEs of OF INTEGER to OF SMALLINT (just in case they're used in a RECORD)</li>
|
||||||
|
<li>Implement any REETODOs that appear in compiled executables</li>
|
||||||
|
<li>Anything passing 0 for the Attr parameter to FindFirst should pass AnyFile instead (VP returns no files when 0 is passed for Attr)</li>
|
||||||
|
<li>Investigate FILEMODE usage to see if FILEMODEREADWRITE, TEXTMODEREAD or TEXTMODEREADWRITE should be used</li>
|
||||||
|
<li>Find/correct any usage of FOR loop variables after the loop (since they are 1 greater in VP than in BP</li>
|
||||||
|
</ul>
|
||||||
|
|
||||||
|
Completed list<br />
|
||||||
|
<ul>
|
||||||
|
</ul>
|
|
@ -0,0 +1,140 @@
|
||||||
|
unit BufUnit;
|
||||||
|
{$I-,R-,S-,Q-}
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Large char-buffer handling routines for EleCOM
|
||||||
|
**
|
||||||
|
** Copyright (c) 1998-2002 by Maarten Bekers
|
||||||
|
**
|
||||||
|
** Version : 1.03
|
||||||
|
** Created : 05-Jan-1999
|
||||||
|
** Last update : 12-Jan-2003
|
||||||
|
**
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
Type CharBufType = Array[0..65520] of Char;
|
||||||
|
|
||||||
|
type BufArrayObj = Object
|
||||||
|
TxtArr : CharBufType;
|
||||||
|
TxtMaxLen : Longint;
|
||||||
|
TxtStartPtr: Longint; { Start of buffer ptr }
|
||||||
|
CurTxtPtr : Longint; { Maximum data entered yet }
|
||||||
|
TmpBuf : CharBufType;
|
||||||
|
|
||||||
|
constructor Init(TxtSize: Longint);
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function BufRoom: Longint;
|
||||||
|
function BufUsed: Longint;
|
||||||
|
function Put(var Buf; Size: Longint): Longint;
|
||||||
|
function Get(var Buf; Size: Longint; Remove: Boolean): Longint;
|
||||||
|
|
||||||
|
procedure Clear;
|
||||||
|
end; { BufArrayObj }
|
||||||
|
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor BufArrayObj.Init(TxtSize: Longint);
|
||||||
|
begin
|
||||||
|
TxtMaxLen := TxtSize;
|
||||||
|
CurTxtPtr := -1;
|
||||||
|
TxtStartPtr := 0;
|
||||||
|
|
||||||
|
FillChar(TxtArr, TxtMaxLen, #00);
|
||||||
|
FillChar(TmpBuf, TxtMaxLen, #00);
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor BufArrayObj.Done;
|
||||||
|
begin
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function BufArrayObj.BufRoom: Longint;
|
||||||
|
begin
|
||||||
|
BufRoom := (TxtMaxLen - (CurTxtPtr + 1));
|
||||||
|
end; { func. BufRoom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function BufArrayObj.BufUsed: Longint;
|
||||||
|
begin
|
||||||
|
BufUsed := (CurTxtPtr + 01);
|
||||||
|
end; { func. BufUsed }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function BufArrayObj.Put(var Buf; Size: Longint): Longint;
|
||||||
|
var RetSize: Longint;
|
||||||
|
begin
|
||||||
|
Put := 0;
|
||||||
|
if Size < 0 then EXIT;
|
||||||
|
|
||||||
|
if TxtStartPtr > 0 then
|
||||||
|
if (CurTxtPtr + TxtStartPtr) > TxtMaxLen then
|
||||||
|
begin
|
||||||
|
Move(TxtArr[TxtStartPtr], TxtArr[0], Succ(CurTxtPtr));
|
||||||
|
TxtStartPtr := 0;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
if Size > BufRoom then RetSize := BufRoom
|
||||||
|
else RetSize := Size;
|
||||||
|
|
||||||
|
Move(Buf, TxtArr[TxtStartPtr + BufUsed], RetSize);
|
||||||
|
|
||||||
|
Inc(CurTxtPtr, RetSize);
|
||||||
|
TxtArr[TxtStartPtr + BufUsed + 1] := #0;
|
||||||
|
Put := RetSize;
|
||||||
|
end; { func. Put }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function BufArrayObj.Get(var Buf; Size: Longint; Remove: Boolean): Longint;
|
||||||
|
var RetSize: Longint;
|
||||||
|
begin
|
||||||
|
Get := 0;
|
||||||
|
if Size < 0 then EXIT;
|
||||||
|
|
||||||
|
if Size > BufUsed then RetSize := BufUsed
|
||||||
|
else RetSize := Size;
|
||||||
|
|
||||||
|
Move(TxtArr[TxtStartPtr], Buf, RetSize);
|
||||||
|
|
||||||
|
Get := RetSize;
|
||||||
|
|
||||||
|
if Remove then
|
||||||
|
begin
|
||||||
|
if RetSize = BufUsed then
|
||||||
|
begin
|
||||||
|
CurTxtPtr := -1;
|
||||||
|
TxtStartPtr := 0;
|
||||||
|
TxtArr[0] := #0;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
Inc(TxtStartPtr, RetSize);
|
||||||
|
Dec(CurTxtPtr, RetSize);
|
||||||
|
TxtArr[CurTxtPtr + TxtStartPtr + 1] := #0;
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end; { func. Get }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure BufArrayObj.Clear;
|
||||||
|
begin
|
||||||
|
CurTxtPtr := -1;
|
||||||
|
end; { proc. Clear }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,309 @@
|
||||||
|
unit ComBase;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 21-May-1998
|
||||||
|
** Last update : 14-May-1999
|
||||||
|
**
|
||||||
|
** Note: (c)1998-2003 by Maarten Bekers
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
{$IFDEF VirtualPascal}
|
||||||
|
uses Use32;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Type ShortString = String;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type SliceProc = procedure;
|
||||||
|
|
||||||
|
type TCommObj = Object
|
||||||
|
DontClose : Boolean;
|
||||||
|
InitFailed : Boolean;
|
||||||
|
ErrorStr : ShortString;
|
||||||
|
BlockAll : Boolean;
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
||||||
|
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
||||||
|
function Com_GetBPSrate: Longint; virtual;
|
||||||
|
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
||||||
|
procedure Com_SetDtr(State: Boolean); virtual;
|
||||||
|
|
||||||
|
function Com_CharAvail: Boolean; virtual;
|
||||||
|
function Com_Carrier: Boolean; virtual;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
||||||
|
|
||||||
|
function Com_GetChar: Char; virtual;
|
||||||
|
function Com_PeekChar: Char; virtual;
|
||||||
|
function Com_SendChar(C: Char): Boolean; virtual;
|
||||||
|
function Com_GetDriverInfo: String; virtual;
|
||||||
|
function Com_GetHandle: Longint; virtual;
|
||||||
|
function Com_InitSucceeded: Boolean; virtual;
|
||||||
|
|
||||||
|
procedure Com_Close; virtual;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); virtual;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_PurgeOutBuffer; virtual;
|
||||||
|
procedure Com_PurgeInBuffer; virtual;
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc); virtual;
|
||||||
|
procedure Com_SendString(Temp: ShortString); virtual;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
||||||
|
|
||||||
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
||||||
|
|
||||||
|
end; { object TCommObj }
|
||||||
|
|
||||||
|
Type PCommObj = ^TCommObj;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
{-- We disable warnings as this is just an abstract -}
|
||||||
|
|
||||||
|
constructor TCommObj.Init;
|
||||||
|
begin
|
||||||
|
DontClose := false;
|
||||||
|
InitFailed := false;
|
||||||
|
BlockAll := false;
|
||||||
|
ErrorStr := '';
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TCommObj.Done;
|
||||||
|
begin
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_Open := FALSE;
|
||||||
|
end; { func. Com_Open }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_OpenQuick(Handle: Longint);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_Close;
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_Close }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_GetChar: Char;
|
||||||
|
begin
|
||||||
|
Com_GetChar := #0;
|
||||||
|
end; { func. TCommObj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_PeekChar: Char;
|
||||||
|
begin
|
||||||
|
Com_PeekChar := #0;
|
||||||
|
end; { func. TCommObj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_SendChar(C: Char): Boolean;
|
||||||
|
begin
|
||||||
|
Com_SendChar := FALSE;
|
||||||
|
end; { proc. TCommObj.Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_CharAvail: Boolean;
|
||||||
|
begin
|
||||||
|
Com_CharAvail := FALSE;
|
||||||
|
end; { func. TCommObj.Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_Carrier: Boolean;
|
||||||
|
begin
|
||||||
|
Com_Carrier := FALSE;
|
||||||
|
end; { func. Comm_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SetDtr(State: Boolean);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_OpenKeep := FALSE;
|
||||||
|
end; { func. TCommObj.Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Com_ReadyToSend := FALSE;
|
||||||
|
end; { func. TCommObj.Com_ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_GetBPSrate: Longint;
|
||||||
|
begin
|
||||||
|
Com_GetBpsRate := -1;
|
||||||
|
end; { func. TCommObj.Com_GetBPSrate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
end; { proc. TCommObj.Com_PurgeOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_GetDriverInfo: String;
|
||||||
|
begin
|
||||||
|
Com_GetDriverInfo := '';
|
||||||
|
end; { func. Com_GetDriverInfo }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_GetHandle: Longint;
|
||||||
|
begin
|
||||||
|
Com_GetHandle := -1;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_PauseCom(CloseCom: Boolean);
|
||||||
|
begin
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
begin
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TCommObj.Com_InitSucceeded: Boolean;
|
||||||
|
begin
|
||||||
|
Com_InitSucceeded := NOT InitFailed;
|
||||||
|
end; { func. Com_InitFailed }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_FlushOutBuffer(Slice: SliceProc);
|
||||||
|
var InFree,
|
||||||
|
OutFree,
|
||||||
|
InUsed,
|
||||||
|
OutUsed : Longint;
|
||||||
|
begin
|
||||||
|
Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed);
|
||||||
|
|
||||||
|
while (OutUsed > 1) AND (Com_Carrier) do
|
||||||
|
{ X00 (fossil) will never go below 1 ! }
|
||||||
|
begin
|
||||||
|
Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed);
|
||||||
|
|
||||||
|
if @Slice <> nil then
|
||||||
|
begin
|
||||||
|
Slice;
|
||||||
|
Slice;
|
||||||
|
end; { if }
|
||||||
|
end; { while }
|
||||||
|
end; { proc. Com_FlushOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc);
|
||||||
|
begin
|
||||||
|
Com_SendBlock(Block, BlockLen, Written);
|
||||||
|
end; { proc. Com_SendWait }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SendString(Temp: ShortString);
|
||||||
|
var Written: Longint;
|
||||||
|
begin
|
||||||
|
Com_SendBlock(Temp[1], Length(Temp), Written);
|
||||||
|
end; { proc. Com_SendString }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
begin
|
||||||
|
end; { proc. Com_Setflow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TCommObj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
||||||
|
begin
|
||||||
|
end; { Com_SetDataProc }
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,350 @@
|
||||||
|
library ELECOM13;
|
||||||
|
{$H-} { important, turn off Ansi-Strings }
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.02
|
||||||
|
** Created : 13-Jun-1999
|
||||||
|
** Last update : 28-Jun-2000
|
||||||
|
**
|
||||||
|
** Note: (c)1998-1999 by Maarten Bekers.
|
||||||
|
** If you have any suggestions, please let me know.
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
uses ComBase,
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
W32SNGL,
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Os2Com,
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Telnet;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
var ComObj : pCommObj;
|
||||||
|
ComSystem: Longint;
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComReadProc(var TempPtr: Pointer); stdcall;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : POs2Obj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComWriteProc(var TempPtr: Pointer); stdcall;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : POs2Obj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComWriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_Startup(ObjectType: Longint); stdcall;
|
||||||
|
begin
|
||||||
|
ComSystem := ObjectType;
|
||||||
|
|
||||||
|
Case Objecttype of
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
01 : ComObj := New(pWin32Obj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
01 : ComObj := New(pOs2Obj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
02 : ComObj := New(pTelnetObj, Init);
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
end; { proc. Com_Startup }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_OpenQuick(Handle);
|
||||||
|
end; { proc. Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_Open(Comport, BaudRate, DataBits, Parity, StopBits);
|
||||||
|
end; { func. Com_Open }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_OpenKeep(Comport);
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_GetModemStatus(LineStatus, ModemStatus);
|
||||||
|
end; { proc. Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SetLine(BpsRate, Parity, DataBits, StopBits);
|
||||||
|
end; { proc. Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetBPSrate: Longint; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_GetBpsRate;
|
||||||
|
end; { func. Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed);
|
||||||
|
end; { proc. Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetDtr(State: Boolean); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SetDtr(State);
|
||||||
|
end; { proc. Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_CharAvail: Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_CharAvail;
|
||||||
|
end; { func. Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_Carrier: Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_Carrier;
|
||||||
|
end; { func. Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_ReadyToSend(BlockLen);
|
||||||
|
end; { func. Com_ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetChar: Char; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_GetChar;
|
||||||
|
end; { func. Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_SendChar(C: Char): Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_SendChar(C);
|
||||||
|
end; { func. Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetDriverInfo: String; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_GetDriverInfo;
|
||||||
|
end; { func. Com_GetDriverInfo }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetHandle: Longint; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_GetHandle;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_InitSucceeded: Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.Com_InitSucceeded;
|
||||||
|
end; { func. Com_InitSucceeded }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_Close; stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_Close;
|
||||||
|
end; { proc. Com_Close }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SendBlock(Block, BlockLen, Written);
|
||||||
|
end; { proc. Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SendWait(Block, BlockLen, Written, Slice);
|
||||||
|
end; { proc. Com_SendWait }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_ReadBlock(Block, BlockLen, Reads);
|
||||||
|
end; { proc. Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_PurgeOutBuffer; stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_PurgeOutBuffer;
|
||||||
|
end; { proc. Com_PurgeOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_PurgeInBuffer; stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_PurgeInBuffer;
|
||||||
|
end; { proc. Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_PauseCom(CloseCom);
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_ResumeCom(OpenCom);
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_FlushOutBuffer(Slice);
|
||||||
|
end; { proc. Com_FlushOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SendString(Temp: String); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SendString(Temp);
|
||||||
|
end; { Com_SendString }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetDontClose(Value: Boolean); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.DontClose := Value;
|
||||||
|
end; { proc. Com_SetDontClose }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); stdcall;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SetFlow(SoftTX, SoftRX, Hard);
|
||||||
|
end; { proc. Com_Setflow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_ShutDown; stdcall;
|
||||||
|
begin
|
||||||
|
Dispose(ComObj, Done);
|
||||||
|
end; { proc. Com_ShutDown }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_InitFailed: Boolean; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.InitFailed;
|
||||||
|
end; { func. Com_Initfailed }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_ErrorStr: String; stdcall;
|
||||||
|
begin
|
||||||
|
Result := ComObj^.ErrorStr;
|
||||||
|
end; { func. Com_ErrorStr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
exports
|
||||||
|
Com_Startup index 1 name 'Com_Startup',
|
||||||
|
Com_Open index 2 name 'Com_Open',
|
||||||
|
Com_OpenQuick index 3 name 'Com_OpenQuick',
|
||||||
|
Com_OpenKeep index 4 name 'Com_OpenKeep',
|
||||||
|
Com_GetModemStatus index 5 name 'Com_GetModemStatus',
|
||||||
|
Com_SetLine index 6 name 'Com_SetLine',
|
||||||
|
Com_GetBPSrate index 7 name 'Com_GetBPSrate',
|
||||||
|
Com_GetBufferStatus index 8 name 'Com_GetBufferStatus',
|
||||||
|
Com_SetDtr index 09 name 'Com_SetDtr',
|
||||||
|
Com_CharAvail index 10 name 'Com_CharAvail',
|
||||||
|
Com_Carrier index 11 name 'Com_Carrier',
|
||||||
|
Com_ReadyToSend index 12 name 'Com_ReadyToSend',
|
||||||
|
Com_GetChar index 13 name 'Com_GetChar',
|
||||||
|
Com_SendChar index 14 name 'Com_SendChar',
|
||||||
|
Com_GetDriverInfo index 15 name 'Com_GetDriverInfo',
|
||||||
|
Com_GetHandle index 16 name 'Com_GetHandle',
|
||||||
|
Com_InitSucceeded index 17 name 'Com_InitSucceeded',
|
||||||
|
Com_Close index 18 name 'Com_Close',
|
||||||
|
Com_SendBlock index 19 name 'Com_SendBlock',
|
||||||
|
Com_SendWait index 20 name 'Com_SendWait',
|
||||||
|
Com_ReadBlock index 21 name 'Com_ReadBlock',
|
||||||
|
Com_PurgeOutBuffer index 22 name 'Com_PurgeOutBuffer',
|
||||||
|
Com_PurgeInBuffer index 23 name 'Com_PurgeInBuffer',
|
||||||
|
Com_PauseCom index 24 name 'Com_PauseCom',
|
||||||
|
Com_ResumeCom index 25 name 'Com_ResumeCom',
|
||||||
|
Com_FlushOutBuffer index 26 name 'Com_FlushOutBuffer',
|
||||||
|
Com_SendString index 27 name 'Com_SendString',
|
||||||
|
Com_ShutDown index 28 name 'Com_ShutDown',
|
||||||
|
Com_SetDontClose index 29 name 'Com_SetDontClose',
|
||||||
|
Com_SetFlow index 30 name 'Com_SetFlow',
|
||||||
|
Com_InitFailed index 31 name 'Com_InitFailed',
|
||||||
|
Com_ErrorStr index 32 name 'Com_ErrorStr';
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
begin
|
||||||
|
ComObj := nil;
|
||||||
|
end.
|
|
@ -0,0 +1,101 @@
|
||||||
|
unit ELEDEF;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.03
|
||||||
|
** Created : 13-Jun-1999
|
||||||
|
** Last update : 05-Aug-2000
|
||||||
|
**
|
||||||
|
** Note: (c)1998-1999 by Maarten Bekers.
|
||||||
|
** If you have any suggestions, please let me know.
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
Const
|
||||||
|
ComNameDLL = 'elecom13.dll';
|
||||||
|
|
||||||
|
type SliceProc = procedure;
|
||||||
|
|
||||||
|
procedure Com_Startup(ObjectType: Longint); stdcall;
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; stdcall;
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); stdcall;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; stdcall;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); stdcall;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); stdcall;
|
||||||
|
function Com_GetBPSrate: Longint; stdcall;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); stdcall;
|
||||||
|
procedure Com_SetDtr(State: Boolean); stdcall;
|
||||||
|
function Com_CharAvail: Boolean; stdcall;
|
||||||
|
function Com_Carrier: Boolean; stdcall;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
function Com_GetChar: Char; stdcall;
|
||||||
|
function Com_SendChar(C: Char): Boolean; stdcall;
|
||||||
|
function Com_GetDriverInfo: String; stdcall;
|
||||||
|
function Com_GetHandle: Longint; stdcall;
|
||||||
|
function Com_InitSucceeded: Boolean; stdcall;
|
||||||
|
procedure Com_Close; stdcall;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); stdcall;
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); stdcall;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); stdcall;
|
||||||
|
procedure Com_PurgeOutBuffer; stdcall;
|
||||||
|
procedure Com_PurgeInBuffer; stdcall;
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); stdcall;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); stdcall;
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc); stdcall;
|
||||||
|
procedure Com_SendString(Temp: String); stdcall;
|
||||||
|
procedure Com_ShutDown; stdcall;
|
||||||
|
procedure Com_SetDontClose(Value: Boolean); stdcall;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); stdcall;
|
||||||
|
function Com_InitFailed: Boolean; stdcall;
|
||||||
|
function Com_ErrorStr: String; stdcall;
|
||||||
|
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_Startup(ObjectType: Longint); external ComNameDLL index 1;
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; external ComNameDLL index 2;
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); external ComNameDLL index 3;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; external ComNameDLL index 4;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); external ComNameDLL index 5;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); external ComNameDLL index 6;
|
||||||
|
function Com_GetBPSrate: Longint; external ComNameDLL index 7;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); external ComNameDLL index 8;
|
||||||
|
procedure Com_SetDtr(State: Boolean); external ComNameDLL index 9;
|
||||||
|
function Com_CharAvail: Boolean; external ComNameDLL index 10;
|
||||||
|
function Com_Carrier: Boolean; external ComNameDLL index 11;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; external ComNameDLL index 12;
|
||||||
|
function Com_GetChar: Char; external ComNameDLL index 13;
|
||||||
|
function Com_SendChar(C: Char): Boolean; external ComNameDLL index 14;
|
||||||
|
function Com_GetDriverInfo: String; external ComNameDLL index 15;
|
||||||
|
function Com_GetHandle: Longint; external ComNameDLL index 16;
|
||||||
|
function Com_InitSucceeded: Boolean; external ComNameDLL index 17;
|
||||||
|
procedure Com_Close; external ComNameDLL index 18;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); external ComNameDLL index 19;
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); external ComNameDLL index 20;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); external ComNameDLL index 21;
|
||||||
|
procedure Com_PurgeOutBuffer; external ComNameDLL index 22;
|
||||||
|
procedure Com_PurgeInBuffer; external ComNameDLL index 23;
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); external ComNameDLL index 24;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); external ComNameDLL index 25;
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc); external ComNameDLL index 26;
|
||||||
|
procedure Com_SendString(Temp: String); external ComNameDLL index 27;
|
||||||
|
procedure Com_ShutDown; external ComNameDLL index 28;
|
||||||
|
procedure Com_SetDontClose(Value: Boolean); external ComNameDLL index 29;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); external ComNameDLL index 30;
|
||||||
|
function Com_InitFailed: Boolean; external ComNameDLL index 31;
|
||||||
|
function Com_ErrorStr: String; external ComNameDLL index 32;
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,376 @@
|
||||||
|
unit EleNORM;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 13-Jun-1999
|
||||||
|
** Last update : 28-Jun-2000
|
||||||
|
**
|
||||||
|
** Note: (c)1998 - 2000 by Maarten Bekers. This unit tries to make it easier
|
||||||
|
** to use EleCOM.
|
||||||
|
**
|
||||||
|
** Usage:
|
||||||
|
** Before calling any of these routines, first call Com_StartUp:
|
||||||
|
** Pass the following number to it:
|
||||||
|
** 01 - Use the "modem" communications (OS/2, Win32 or FOSSIL)
|
||||||
|
** 02 - Use the TELNET type (OS/2 or Win32 only).
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses ComBase
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
, W32SNGL
|
||||||
|
, Telnet
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
, Telnet
|
||||||
|
, Os2com
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
, Fos_Com
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
, Fos_com
|
||||||
|
{$ENDIF} ;
|
||||||
|
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
function Com_CharAvail: Boolean;
|
||||||
|
function Com_Carrier: Boolean;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
function Com_GetChar: Char;
|
||||||
|
function Com_PeekChar: Char;
|
||||||
|
function Com_SendChar(C: Char): Boolean;
|
||||||
|
function Com_GetDriverInfo: String;
|
||||||
|
function Com_GetHandle: Longint;
|
||||||
|
function Com_InitSucceeded: Boolean;
|
||||||
|
procedure Com_Startup(ObjectType: Longint);
|
||||||
|
procedure Com_OpenQuick(Handle: Longint);
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
procedure Com_SetDtr(State: Boolean);
|
||||||
|
procedure Com_Close;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc);
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
procedure Com_PurgeOutBuffer;
|
||||||
|
procedure Com_PurgeInBuffer;
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean);
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc);
|
||||||
|
procedure Com_SendString(Temp: String);
|
||||||
|
procedure Com_SetDontClose(Value: Boolean);
|
||||||
|
procedure Com_ShutDown;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
var ComObj : pCommObj;
|
||||||
|
ComSystem: Longint;
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComReadProc(var TempPtr: Pointer);
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : POs2Obj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComWriteProc(var TempPtr: Pointer);
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case ComSystem of
|
||||||
|
1 : POs2Obj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
2 : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComWriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_Startup(ObjectType: Longint);
|
||||||
|
begin
|
||||||
|
ComSystem := ObjectType;
|
||||||
|
|
||||||
|
Case Objecttype of
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
01 : ComObj := New(pWin32Obj, Init);
|
||||||
|
02 : ComObj := New(pTelnetObj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
01 : ComObj := New(pOs2Obj, Init);
|
||||||
|
02 : ComObj := New(pTelnetObj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
01 : ComObj := New(pFossilObj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
01 : ComObj := New(pFossilObj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Com_Startup }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_OpenQuick(Handle);
|
||||||
|
end; { proc. Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_Open := ComObj^.Com_Open(Comport, BaudRate, DataBits, Parity, StopBits);
|
||||||
|
end; { func. Com_Open }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_OpenKeep := ComObj^.Com_OpenKeep(Comport);
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_GetModemStatus(LineStatus, ModemStatus);
|
||||||
|
end; { proc. Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SetLine(BpsRate, Parity, DataBits, StopBits);
|
||||||
|
end; { proc. Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetBPSrate: Longint;
|
||||||
|
begin
|
||||||
|
Com_GetBpsRate := ComObj^.Com_GetBpsRate;
|
||||||
|
end; { func. Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed);
|
||||||
|
end; { proc. Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetDtr(State: Boolean);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SetDtr(State);
|
||||||
|
end; { proc. Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_CharAvail: Boolean;
|
||||||
|
begin
|
||||||
|
Com_CharAvail := ComObj^.Com_CharAvail;
|
||||||
|
end; { func. Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_Carrier: Boolean;
|
||||||
|
begin
|
||||||
|
Com_Carrier := ComObj^.Com_Carrier;
|
||||||
|
end; { func. Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Com_ReadyToSend := ComObj^.Com_ReadyToSend(BlockLen);
|
||||||
|
end; { func. Com_ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetChar: Char;
|
||||||
|
begin
|
||||||
|
Com_GetChar := ComObj^.Com_GetChar;
|
||||||
|
end; { func. Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_PeekChar: Char;
|
||||||
|
begin
|
||||||
|
Com_PeekChar := ComObj^.Com_PeekChar;
|
||||||
|
end; { func. Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_SendChar(C: Char): Boolean;
|
||||||
|
begin
|
||||||
|
Com_SendChar := ComObj^.Com_SendChar(C);
|
||||||
|
end; { func. Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetDriverInfo: String;
|
||||||
|
begin
|
||||||
|
Com_GetDriverInfo := ComObj^.Com_GetDriverInfo;
|
||||||
|
end; { func. Com_GetDriverInfo }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_GetHandle: Longint;
|
||||||
|
begin
|
||||||
|
Com_GetHandle := ComObj^.Com_GetHandle;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function Com_InitSucceeded: Boolean;
|
||||||
|
begin
|
||||||
|
Com_InitSucceeded := ComObj^.Com_InitSucceeded;
|
||||||
|
end; { func. Com_InitSucceeded }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_Close;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_Close;
|
||||||
|
end; { proc. Com_Close }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SendBlock(Block, BlockLen, Written);
|
||||||
|
end; { proc. Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SendWait(Block, BlockLen, Written, Slice);
|
||||||
|
end; { proc. Com_SendWait }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_ReadBlock(Block, BlockLen, Reads);
|
||||||
|
end; { proc. Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_PurgeOutBuffer;
|
||||||
|
end; { proc. Com_PurgeOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
ComObj^.Com_PurgeInBuffer;
|
||||||
|
end; { proc. Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_PauseCom(CloseCom);
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_ResumeCom(OpenCom);
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_FlushOutBuffer(Slice);
|
||||||
|
end; { proc. Com_FlushOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SendString(Temp: String);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SendString(Temp);
|
||||||
|
end; { Com_SendString }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetDontClose(Value: Boolean);
|
||||||
|
begin
|
||||||
|
ComObj^.DontClose := Value;
|
||||||
|
end; { proc. Com_SetDontClose }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_ShutDown;
|
||||||
|
begin
|
||||||
|
Dispose(ComObj, Done);
|
||||||
|
end; { proc. Com_ShutDown }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
begin
|
||||||
|
ComObj^.Com_SetFlow(SoftTX, SoftRX, Hard);
|
||||||
|
end; { proc. Com_SetFlow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
begin
|
||||||
|
ComObj := nil;
|
||||||
|
end.
|
|
@ -0,0 +1,150 @@
|
||||||
|
program Exam2;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** EXAMPLE how to use communications
|
||||||
|
** This is only an example of how to use EleCOM independently of a BBS program,
|
||||||
|
** to see an example how to use EleCOM as a door from a BBS program, see
|
||||||
|
** EXAMPLE.PAS
|
||||||
|
** TELNET is not supported as we dont have a telnet server
|
||||||
|
**
|
||||||
|
** version: 1.01
|
||||||
|
** Created: 30-Sep-1999
|
||||||
|
**
|
||||||
|
** Fire up line: EXAM2.EXE -C<comport>
|
||||||
|
** eg: EXAM2.EXE -C4
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
{.DEFINE FOSSIL}
|
||||||
|
{.DEFINE OS2COM}
|
||||||
|
{$DEFINE W32COM}
|
||||||
|
|
||||||
|
{$IFNDEF FOSSIL}
|
||||||
|
{$IFNDEF OS2COM}
|
||||||
|
{$IFNDEF W32COM}
|
||||||
|
You need to define one of these..
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
uses Combase,
|
||||||
|
{$IFDEF FOSSIL}
|
||||||
|
Fos_Com
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2COM}
|
||||||
|
Os2Com
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF W32COM}
|
||||||
|
W32SNGL
|
||||||
|
{$ENDIF} ;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
var ComObj : PCommObj;
|
||||||
|
ComPort : Longint;
|
||||||
|
ReadCH : Char;
|
||||||
|
IsTelnet : Boolean;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComReadProc(var TempPtr: Pointer);
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : POs2Obj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComWriteProc(var TempPtr: Pointer);
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : POs2Obj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComWriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure ParseCommandLine;
|
||||||
|
var Counter: Longint;
|
||||||
|
TempStr: String;
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Code : Integer;
|
||||||
|
{$ELSE}
|
||||||
|
Code : Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
for Counter := 01 to ParamCount do
|
||||||
|
begin
|
||||||
|
TempStr := ParamStr(Counter);
|
||||||
|
|
||||||
|
if TempStr[1] in ['/', '-'] then
|
||||||
|
Case UpCase(TempStr[2]) of
|
||||||
|
'C' : begin
|
||||||
|
|
||||||
|
TempStr := Copy(TempStr, 3, Length(TempStr) - 2);
|
||||||
|
Val(TempStr, ComPort, Code);
|
||||||
|
|
||||||
|
end; { 'C' }
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
end; { for }
|
||||||
|
end; { proc. ParseCommandLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
|
||||||
|
begin
|
||||||
|
IsTelnet := false;
|
||||||
|
ParseCommandLine;
|
||||||
|
|
||||||
|
{$IFDEF W32COM}
|
||||||
|
ComObj := New(PWin32Obj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF FOSSIL}
|
||||||
|
ComObj := New(PFossilObj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2COM}
|
||||||
|
ComObj := New(POs2Obj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
ComObj^.Com_OpenKeep(Comport); { Dont change any comport settings }
|
||||||
|
ComObj^.Com_SendString('Hello there!' + #13#10);
|
||||||
|
|
||||||
|
repeat
|
||||||
|
ReadCH := ComObj^.Com_GetChar;
|
||||||
|
|
||||||
|
if ReadCH <> #13 then
|
||||||
|
Writeln('Other..');
|
||||||
|
until (ReadCH = #13) OR (NOT ComObj^.Com_Carrier);
|
||||||
|
|
||||||
|
Dispose(ComObj, Done); { Dispose the communications object }
|
||||||
|
end.
|
|
@ -0,0 +1,550 @@
|
||||||
|
unit FOS_COM;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 21-May-1998
|
||||||
|
** Last update : 07-Apr-1999
|
||||||
|
**
|
||||||
|
** Note: (c) 1998-1999 by Maarten Bekers
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses Dos, Combase;
|
||||||
|
|
||||||
|
type TFossilObj = Object(TCommObj)
|
||||||
|
Regs : Registers;
|
||||||
|
FosPort: Byte;
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
||||||
|
function Com_GetChar: Char; virtual;
|
||||||
|
function Com_CharAvail: Boolean; virtual;
|
||||||
|
function Com_Carrier: Boolean; virtual;
|
||||||
|
function Com_SendChar(C: Char): Boolean; virtual;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
||||||
|
function Com_GetBPSrate: Longint; virtual;
|
||||||
|
function Com_GetDriverInfo: String; virtual;
|
||||||
|
function Com_GetHandle: longint; virtual;
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
||||||
|
procedure Com_Close; virtual;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
||||||
|
procedure Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc); virtual;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
||||||
|
procedure Com_SetDtr(State: Boolean); virtual;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
||||||
|
procedure Com_PurgeInBuffer; virtual;
|
||||||
|
procedure Com_PurgeOutBuffer; virtual;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
||||||
|
end; { object TFossilObj }
|
||||||
|
|
||||||
|
Type PFossilObj = ^TFossilObj;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses Strings
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
,Go32
|
||||||
|
{$ENDIF} ;
|
||||||
|
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure DosAlloc(var Selector: Word; var SegMent: Word; Size: Longint);
|
||||||
|
var Res: Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
Res := Global_DOS_Alloc(Size);
|
||||||
|
Selector := Word(Res);
|
||||||
|
|
||||||
|
Segment := Word(RES SHR 16);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. DosAlloc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure DosFree(Selector: Word);
|
||||||
|
begin
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
Global_DOS_Free(Selector);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. DosFree }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TFossilObj.Init;
|
||||||
|
begin
|
||||||
|
inherited Init;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TFossilObj.Done;
|
||||||
|
begin
|
||||||
|
inherited Done;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure FossilIntr(var Regs: Registers);
|
||||||
|
begin
|
||||||
|
Intr($14, Regs);
|
||||||
|
end; { proc. FossilIntr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
{-------------------------- Open the comport -----------------------------}
|
||||||
|
FosPort := (ComPort - 01);
|
||||||
|
|
||||||
|
Regs.AH := $04;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.BX := $4F50;
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Com_Open := (Regs.AX = $1954);
|
||||||
|
InitFailed := (Regs.AX <> $1954);
|
||||||
|
Com_SetLine(BaudRate, Parity, DataBits, StopBits);
|
||||||
|
end; { func. TFossilObj.Com_OpenCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
FosPort := (ComPort - 01);
|
||||||
|
|
||||||
|
Regs.AH := $04;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.BX := $4F50;
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Com_OpenKeep := (Regs.AX = $1954);
|
||||||
|
InitFailed := (Regs.AX <> $1954);
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_OpenQuick(Handle: Longint);
|
||||||
|
begin
|
||||||
|
{-------------------------- Open the comport -----------------------------}
|
||||||
|
FosPort := (Handle - 01);
|
||||||
|
|
||||||
|
Regs.AH := $04;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.BX := $4F50;
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
InitFailed := (Regs.AX <> $1954);
|
||||||
|
end; { proc. Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
var BPS: Byte;
|
||||||
|
begin
|
||||||
|
if BpsRate > 65534 then
|
||||||
|
BpsRate := 65534;
|
||||||
|
|
||||||
|
Case Word(BpsRate) of { have to typecast to word, else will rte201 in dos }
|
||||||
|
1200 : BPS := 128;
|
||||||
|
2400 : BPS := 160;
|
||||||
|
4800 : BPS := 192;
|
||||||
|
9600 : BPS := 224;
|
||||||
|
19200 : BPS := 0
|
||||||
|
else BPS := 32;
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
if DataBits in [6..8] then
|
||||||
|
BPS := BPS + (DataBits - 5);
|
||||||
|
|
||||||
|
if Parity = 'O' then BPS := BPS + 8 else
|
||||||
|
If Parity = 'E' then BPS := BPS + 24;
|
||||||
|
|
||||||
|
if StopBits = 2 then BPS := BPS + 04;
|
||||||
|
|
||||||
|
Regs.AH := $00;
|
||||||
|
Regs.AL := BPS;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
end; { proc. TFossilObj.Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_GetBPSrate: Longint;
|
||||||
|
begin
|
||||||
|
Com_GetBpsRate := 115200;
|
||||||
|
end; { func. TFossilObj.Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_Close;
|
||||||
|
begin
|
||||||
|
if Dontclose then EXIT;
|
||||||
|
|
||||||
|
Regs.AH := $05;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
end; { proc. TFossilObj.Com_Close }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_SendChar(C: Char): Boolean;
|
||||||
|
var Written: Longint;
|
||||||
|
begin
|
||||||
|
Com_SendWait(C, SizeOf(c), Written, nil);
|
||||||
|
|
||||||
|
Com_SendChar := (Written >= SizeOf(c));
|
||||||
|
end; { proc. TFossilObj.Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_GetChar: Char;
|
||||||
|
begin
|
||||||
|
Regs.AH := $02;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Com_GetChar := Chr(Regs.AL);
|
||||||
|
end; { proc. TFossilObj.Com_ReadChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
var Selector,
|
||||||
|
Segment : Word;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Regs.AH := $18;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.CX := Blocklen;
|
||||||
|
Regs.ES := Seg(Block);
|
||||||
|
Regs.DI := Ofs(Block);
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Reads := Regs.AX;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
DosAlloc(Selector, Segment, BlockLen);
|
||||||
|
|
||||||
|
if Int31Error <> 0 then EXIT;
|
||||||
|
DosmemPut(Segment, 0, Block, BlockLen);
|
||||||
|
|
||||||
|
Regs.AH := $18;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.CX := Blocklen;
|
||||||
|
Regs.ES := Segment;
|
||||||
|
Regs.DI := 0;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Reads := Regs.AX;
|
||||||
|
|
||||||
|
DosMemGet(Segment, 0, Block, BlockLen);
|
||||||
|
DosFree(Selector);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. TFossilObj.Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
var Selector,
|
||||||
|
Segment : Word;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Regs.AH := $19;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.CX := Blocklen;
|
||||||
|
Regs.ES := Seg(Block);
|
||||||
|
Regs.DI := Ofs(Block);
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Written := Regs.AX;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
DosAlloc(Selector, Segment, BlockLen);
|
||||||
|
|
||||||
|
if Int31Error <> 0 then EXIT;
|
||||||
|
DosmemPut(Segment, 0, Block, BlockLen);
|
||||||
|
|
||||||
|
Regs.AH := $19;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.CX := Blocklen;
|
||||||
|
Regs.ES := Segment;
|
||||||
|
Regs.DI := 0;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Written := Regs.AX;
|
||||||
|
|
||||||
|
DosMemGet(Segment, 0, Block, BlockLen);
|
||||||
|
DosFree(Selector);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. TFossilObj.Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_CharAvail: Boolean;
|
||||||
|
begin
|
||||||
|
Regs.AH := $03;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Com_CharAvail := (Regs.AH AND 01) <> 00;
|
||||||
|
end; { func. TFossilObj.Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Regs.AH := $03;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Com_ReadyToSend := (Regs.AH AND $20) = $20;
|
||||||
|
end; { func. TFossilObj.Com_ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_Carrier: Boolean;
|
||||||
|
begin
|
||||||
|
Regs.AH := $03;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
Com_Carrier := (Regs.AL AND 128) <> 00;
|
||||||
|
end; { func. TFossilObj.Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_SetDtr(State: Boolean);
|
||||||
|
begin
|
||||||
|
Regs.AH := $06;
|
||||||
|
Regs.AL := Byte(State);
|
||||||
|
Regs.DX := Fosport;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
end; { proc. TFossilObj.Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
begin
|
||||||
|
Regs.AH := $03;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
ModemStatus := Regs.AL;
|
||||||
|
LineStatus := Regs.AH;
|
||||||
|
end; { proc. TFossilObj.Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
type
|
||||||
|
FosRec = record
|
||||||
|
Size : Word;
|
||||||
|
Spec : Byte;
|
||||||
|
Rev : Byte;
|
||||||
|
ID : Pointer;
|
||||||
|
InSize : Word;
|
||||||
|
InFree : Word;
|
||||||
|
OutSize : Word;
|
||||||
|
OutFree : Word;
|
||||||
|
SWidth : Byte;
|
||||||
|
SHeight : Byte;
|
||||||
|
BaudMask : Byte;
|
||||||
|
Junk : Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var Com_Info: FosRec;
|
||||||
|
|
||||||
|
Selector,
|
||||||
|
Segment : Word;
|
||||||
|
begin
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Regs.AH := $1B;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.ES := Seg(Com_Info);
|
||||||
|
Regs.DI := Ofs(Com_Info);
|
||||||
|
Regs.CX := SizeOf(Com_Info);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
DosAlloc(Selector, Segment, SizeOf(Com_Info));
|
||||||
|
if Int31Error <> 0 then EXIT;
|
||||||
|
|
||||||
|
DosmemPut(Segment, 0, Com_Info, SizeOf(Com_Info));
|
||||||
|
|
||||||
|
Regs.AH := $1B;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.ES := Segment;
|
||||||
|
Regs.DI := 0;
|
||||||
|
Regs.CX := SizeOf(Com_Info);
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
DosMemGet(Segment, 0, Com_Info, SizeOf(Com_Info));
|
||||||
|
DosFree(Selector);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
InFree := Com_Info.InFree;
|
||||||
|
InUsed := Com_Info.InSize - Com_Info.InFree;
|
||||||
|
|
||||||
|
OutFree := Com_Info.OutFree;
|
||||||
|
OutUsed := Com_Info.OutSize - Com_Info.OutFree;
|
||||||
|
end; { proc. TFossilObj.Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_GetDriverInfo: String;
|
||||||
|
type
|
||||||
|
FosRec = record
|
||||||
|
Size : Word;
|
||||||
|
Spec : Byte;
|
||||||
|
Rev : Byte;
|
||||||
|
ID : PChar;
|
||||||
|
InSize : Word;
|
||||||
|
InFree : Word;
|
||||||
|
OutSize : Word;
|
||||||
|
OutFree : Word;
|
||||||
|
SWidth : Byte;
|
||||||
|
SHeight : Byte;
|
||||||
|
BaudMask : Byte;
|
||||||
|
Junk : Word;
|
||||||
|
end;
|
||||||
|
|
||||||
|
var Com_Info: FosRec;
|
||||||
|
Segment,
|
||||||
|
Selector: Word;
|
||||||
|
begin
|
||||||
|
FillChar(Com_Info, SizeOf(FosRec), #00);
|
||||||
|
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Regs.AH := $1B;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.ES := Seg(Com_Info);
|
||||||
|
Regs.DI := Ofs(Com_Info);
|
||||||
|
Regs.CX := SizeOf(Com_Info);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF GO32V2}
|
||||||
|
DosAlloc(Selector, Segment, SizeOf(Com_Info));
|
||||||
|
if Int31Error <> 0 then EXIT;
|
||||||
|
|
||||||
|
DosmemPut(Segment, 0, Com_Info, SizeOf(Com_Info));
|
||||||
|
|
||||||
|
Regs.AH := $1B;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
Regs.ES := Segment;
|
||||||
|
Regs.DI := 0;
|
||||||
|
Regs.CX := SizeOf(Com_Info);
|
||||||
|
FossilIntr(Regs);
|
||||||
|
|
||||||
|
DosMemGet(Segment, 0, Com_Info, SizeOf(Com_Info));
|
||||||
|
DosFree(Selector);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
Com_GetDriverInfo := StrPas(Com_Info.ID);
|
||||||
|
end; { proc. TFossilObj.Com_GetDriverInfo }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
Regs.AH := $0A;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
end; { proc. TFossilObj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
Regs.AH := $09;
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
|
||||||
|
FossilIntr(Regs);
|
||||||
|
end; { proc. TFossilObj.Com_PurgeOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TFossilObj.Com_GetHandle: longint;
|
||||||
|
begin
|
||||||
|
Com_GetHandle := FosPort;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_SendWait(var Block; BlockLen: Longint; var Written: Longint; Slice: SliceProc);
|
||||||
|
var RestLen : Longint;
|
||||||
|
Temp : Array[0..(1024 * 50)] of Char ABSOLUTE Block;
|
||||||
|
MaxTries: Longint;
|
||||||
|
begin
|
||||||
|
RestLen := BlockLen;
|
||||||
|
MaxTries := (Com_GetBpsRate div 8);
|
||||||
|
|
||||||
|
repeat
|
||||||
|
Com_SendBlock(Temp[BlockLen - RestLen], RestLen, Written);
|
||||||
|
|
||||||
|
Dec(RestLen, Written);
|
||||||
|
Dec(MaxTries);
|
||||||
|
|
||||||
|
if RestLen <> 0 then
|
||||||
|
if @Slice <> nil then
|
||||||
|
Slice;
|
||||||
|
until (RestLen <= 0) OR (NOT COM_Carrier) OR (MaxTries < 0);
|
||||||
|
|
||||||
|
Written := (BlockLen - RestLen);
|
||||||
|
end; { proc. Com_SendWait }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TFossilObj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
begin
|
||||||
|
Regs.AH := $0F;
|
||||||
|
|
||||||
|
if SoftTX then
|
||||||
|
Regs.AL := $01
|
||||||
|
else Regs.AL := $00;
|
||||||
|
|
||||||
|
if SoftRX then
|
||||||
|
Regs.AL := Regs.AL OR $08;
|
||||||
|
|
||||||
|
if Hard then
|
||||||
|
Regs.AL := Regs.AL OR $02;
|
||||||
|
|
||||||
|
Regs.DX := FosPort;
|
||||||
|
FossilIntr(Regs);
|
||||||
|
end; { proc. Com_SetFlow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,19 @@
|
||||||
|
WHATSNEW
|
||||||
|
========
|
||||||
|
|
||||||
|
30 July 2000 : Initial DoRxEvent and DoTxEvent were set in true state
|
||||||
|
which could cause initial very high CPU usage.
|
||||||
|
18 June 2000 : Changed the way EleCOM calls it threaded functions, making
|
||||||
|
EleCOM useful for applications where more than one comport
|
||||||
|
has to be controlled at a time.
|
||||||
|
20 February 2000 : W32SNGL.PAS or WIN32COM.PAS now include WINDEF.FPC if
|
||||||
|
compiled with the FPC compiler. This include file redefines
|
||||||
|
(some) of the Win32 API calls to make sure they are the
|
||||||
|
correct calling format for us (= the same as with Delphi
|
||||||
|
and VirtualPascal)
|
||||||
|
09 September 1999: W32SNGL.PAS - Reduced the number of threads used by this
|
||||||
|
engine. This one works better on Win9x systems.
|
||||||
|
05 September 1999: TELNET.PAS added some extra error information to make sure
|
||||||
|
errors can be more easily diagnosed.
|
||||||
|
29 August 1999 : ELENORM.PAS - "Plain, vanilly" Pascal version you can use
|
||||||
|
as a wrapper around the OOP code.
|
|
@ -0,0 +1,24 @@
|
||||||
|
WHATSNEW
|
||||||
|
========
|
||||||
|
|
||||||
|
16 June 2002 : Added a very small state machine to the IAC parser of the
|
||||||
|
telnet code, to prevent misses of IAC's on the last
|
||||||
|
character of the buffer.
|
||||||
|
23 December 2000 : Increased buffersizes that Win32 allocates for in/out
|
||||||
|
communications. It now uses 3k, instead of 256 bytes.
|
||||||
|
30 July 2000 : Initial DoRxEvent and DoTxEvent were set in true state
|
||||||
|
which could cause initial very high CPU usage.
|
||||||
|
18 June 2000 : Changed the way EleCOM calls it threaded functions, making
|
||||||
|
EleCOM useful for applications where more than one comport
|
||||||
|
has to be controlled at a time.
|
||||||
|
20 February 2000 : W32SNGL.PAS or WIN32COM.PAS now include WINDEF.FPC if
|
||||||
|
compiled with the FPC compiler. This include file redefines
|
||||||
|
(some) of the Win32 API calls to make sure they are the
|
||||||
|
correct calling format for us (= the same as with Delphi
|
||||||
|
and VirtualPascal)
|
||||||
|
09 September 1999: W32SNGL.PAS - Reduced the number of threads used by this
|
||||||
|
engine. This one works better on Win9x systems.
|
||||||
|
05 September 1999: TELNET.PAS added some extra error information to make sure
|
||||||
|
errors can be more easily diagnosed.
|
||||||
|
29 August 1999 : ELENORM.PAS - "Plain, vanilly" Pascal version you can use
|
||||||
|
as a wrapper around the OOP code.
|
|
@ -0,0 +1,113 @@
|
||||||
|
unit IBMSO32;
|
||||||
|
|
||||||
|
{$OrgName+ }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses OS2Def;
|
||||||
|
|
||||||
|
{$CDECL+}
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_accept(SFamily: ULong;
|
||||||
|
SAddr: pointer;
|
||||||
|
SAddrL: pointer): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_bind(SSocket: ULong;
|
||||||
|
SAddr: pointer;
|
||||||
|
SAddrLen: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_connect(SSocket: ULong;
|
||||||
|
SAddr: pointer;
|
||||||
|
SAddrLen:ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_gethostid: APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_select( Sockets: pointer;
|
||||||
|
noreads, nowrites, noexcepts: longint;
|
||||||
|
timeout: longint ): ApiRet;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_getsockname(SSocket: ULong;
|
||||||
|
SName: pointer;
|
||||||
|
SLength: pointer): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_ioctl(SSocket: ULong;
|
||||||
|
SRequest: longint;
|
||||||
|
SArgp: pointer;
|
||||||
|
ArgSize: longint): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_listen(SSocket: ULong;
|
||||||
|
SQueue: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_getsockopt(SSocket: uLong;
|
||||||
|
sLevel: LongInt;
|
||||||
|
sOptname: LongInt;
|
||||||
|
sOptVal: pchar;
|
||||||
|
var sOptLen: LongInt ): ApiRet;
|
||||||
|
(****************************************************************************)
|
||||||
|
FUNCTION IBM_setsockopt(sSocket: ulong;
|
||||||
|
sLevel: uLong;
|
||||||
|
sOptName: uLong;
|
||||||
|
sOptVal: pointer;
|
||||||
|
sOptLen: uLong ): ApiRet;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_recv(SSocket: ULong;
|
||||||
|
SBuffer: pointer;
|
||||||
|
SLength: ULong;
|
||||||
|
SFlags: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_send(SSocket: ULong;
|
||||||
|
SBuffer: pointer;
|
||||||
|
SLength: ULong;
|
||||||
|
SFlags: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_socket(SDomain: ULong;
|
||||||
|
SType: ULong;
|
||||||
|
SProtocol: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_soclose(SProtocol: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_sock_errno: APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_shutdown(SSocket: ULong;
|
||||||
|
SFlags: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_sock_init: APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_so_cancel(SProtocol: ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
{$CDECL-}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
Version = '00.90';
|
||||||
|
UseString: string = '@(#)import interface unit for IBM TCP/IP so32dll.dll'+#0;
|
||||||
|
CopyRight1: string = '@(#)ibmso32dll Version '+Version+' - 10.10.96'+#0;
|
||||||
|
CopyRight2: string = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'+#0;
|
||||||
|
|
||||||
|
const
|
||||||
|
sockets = 'SO32DLL';
|
||||||
|
network = 'TCP32DLL';
|
||||||
|
|
||||||
|
{$CDECL+}
|
||||||
|
function IBM_accept; external sockets index 1;
|
||||||
|
function IBM_bind; external sockets index 2;
|
||||||
|
function IBM_connect; external sockets index 3;
|
||||||
|
function IBM_gethostid; external sockets index 4;
|
||||||
|
function IBM_getsockname; external sockets index 6;
|
||||||
|
function IBM_ioctl; external sockets index 8;
|
||||||
|
function IBM_listen; external sockets index 9;
|
||||||
|
function IBM_recv; external sockets index 10;
|
||||||
|
function IBM_send; external sockets index 13;
|
||||||
|
function IBM_socket; external sockets index 16;
|
||||||
|
function IBM_soclose; external sockets index 17;
|
||||||
|
function IBM_sock_errno; external sockets index 20;
|
||||||
|
function IBM_shutdown; external sockets index 25;
|
||||||
|
function IBM_sock_init; external sockets index 26;
|
||||||
|
function IBM_so_cancel; external sockets index 18;
|
||||||
|
function IBM_getsockopt; external sockets index 7;
|
||||||
|
function IBM_setsockopt; external sockets index 15;
|
||||||
|
function IBM_select; external sockets index 12;
|
||||||
|
{$CDECL-}
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,53 @@
|
||||||
|
unit IBMTCP32;
|
||||||
|
|
||||||
|
{$OrgName+ }
|
||||||
|
|
||||||
|
interface
|
||||||
|
|
||||||
|
uses OS2Def, SockDef;
|
||||||
|
|
||||||
|
{$CDECL+}
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_gethostbyname(HName: pointer): pointer;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_gethostbyaddr(HAddr: pointer;
|
||||||
|
HAddrLen: longint;
|
||||||
|
HAddrType: ULong): pointer;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_gethostname(HName: pointer;
|
||||||
|
HLength:ULong): APIRET;
|
||||||
|
(****************************************************************************)
|
||||||
|
function IBM_getservbyname(_Name, _Proto: pChar): pServEnt;
|
||||||
|
function inet_addr(_s: pChar): ULONG;
|
||||||
|
|
||||||
|
function getprotobyname(_Name: pChar): pProtoEnt;
|
||||||
|
|
||||||
|
function htonl(_a: LongInt): LongInt;
|
||||||
|
function ntohl(_a: LongInt): LongInt;
|
||||||
|
{ function htons(_a: LongInt): LongInt; }
|
||||||
|
{ function ntohs(_a: SmallInt): SmallInt; }
|
||||||
|
{$CDECL-}
|
||||||
|
|
||||||
|
implementation
|
||||||
|
|
||||||
|
const
|
||||||
|
Version = '00.90';
|
||||||
|
UseString: string = '@(#)import interface unit for IBM TCP/IP tcp32dll.dll'+#0;
|
||||||
|
CopyRight1: string = '@(#)ibmTCP32 Version '+Version+' - 10.10.96'+#0;
|
||||||
|
CopyRight2: string = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'+#0;
|
||||||
|
|
||||||
|
const
|
||||||
|
sockets = 'SO32DLL';
|
||||||
|
network = 'TCP32DLL';
|
||||||
|
|
||||||
|
{$CDECL+}
|
||||||
|
function inet_addr; external network index 5;
|
||||||
|
function IBM_gethostbyname; external network index 11;
|
||||||
|
function IBM_gethostbyaddr; external network index 12;
|
||||||
|
function IBM_gethostname; external network index 44;
|
||||||
|
function getprotobyname; external network index 21;
|
||||||
|
function IBM_getservbyname; external network index 24;
|
||||||
|
function htonl; external network index 3;
|
||||||
|
function ntohl; external network index 3;
|
||||||
|
{$CDECL-}
|
||||||
|
end.
|
|
@ -0,0 +1,786 @@
|
||||||
|
unit OS2COM;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 21-May-1998
|
||||||
|
** Last update : 12-May-1999
|
||||||
|
**
|
||||||
|
** Note: (c) 1998-1999 by Maarten Bekers
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses Combase, BufUnit, Threads,
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Os2Base
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VirtualPascal}
|
||||||
|
,Use32
|
||||||
|
{$ENDIF};
|
||||||
|
|
||||||
|
Const WriteTimeout = 20000; { Wait max. 20 secs }
|
||||||
|
ReadTimeOut = 5000; { General event, 5 secs max }
|
||||||
|
|
||||||
|
InBufSize = 1024 * 32;
|
||||||
|
OutBufSize = 1024 * 32;
|
||||||
|
|
||||||
|
type TOs2Obj = Object(TCommObj)
|
||||||
|
ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
ThreadsInitted: Boolean; { Are the thread(s) up and running? }
|
||||||
|
|
||||||
|
ClientHandle : Longint;
|
||||||
|
|
||||||
|
InBuffer : ^BufArrayObj; { Buffer system internally used }
|
||||||
|
OutBuffer : ^BufArrayObj;
|
||||||
|
|
||||||
|
DoTxEvent : PSysEventObj; { Event manually set when we have to transmit }
|
||||||
|
DoRxEvent : PSysEventObj; { Event manually set when we need data }
|
||||||
|
|
||||||
|
TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed }
|
||||||
|
RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed }
|
||||||
|
|
||||||
|
CriticalTx : PExclusiveObj; { Critical sections }
|
||||||
|
CriticalRx : PExclusiveObj;
|
||||||
|
|
||||||
|
TxThread : PThreadsObj; { The Transmit and Receive threads }
|
||||||
|
RxThread : PThreadsObj;
|
||||||
|
|
||||||
|
EndThreads : Boolean; { Set to true when we have to end the threads }
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
||||||
|
function Com_GetChar: Char; virtual;
|
||||||
|
function Com_CharAvail: Boolean; virtual;
|
||||||
|
function Com_Carrier: Boolean; virtual;
|
||||||
|
function Com_SendChar(C: Char): Boolean; virtual;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
||||||
|
function Com_GetBPSrate: Longint; virtual;
|
||||||
|
function Com_GetHandle: Longint; virtual;
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
||||||
|
procedure Com_Close; virtual;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
||||||
|
procedure Com_SetDtr(State: Boolean); virtual;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
||||||
|
procedure Com_PurgeInBuffer; virtual;
|
||||||
|
procedure Com_PurgeOutBuffer; virtual;
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc); virtual;
|
||||||
|
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
||||||
|
|
||||||
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
||||||
|
|
||||||
|
procedure Com_ReadProc(var TempPtr: Pointer);
|
||||||
|
procedure Com_WriteProc(var TempPtr: Pointer);
|
||||||
|
|
||||||
|
function Com_StartThread: Boolean;
|
||||||
|
procedure Com_InitVars;
|
||||||
|
procedure Com_StopThread;
|
||||||
|
end; { object TOs2Obj }
|
||||||
|
|
||||||
|
Type POs2Obj = ^TOs2Obj;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses SysUtils;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TOs2Obj.Init;
|
||||||
|
begin
|
||||||
|
inherited Init;
|
||||||
|
|
||||||
|
Com_InitVars;
|
||||||
|
ThreadsInitted := FALSE;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TOs2Obj.Done;
|
||||||
|
begin
|
||||||
|
inherited done;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_ReadProc(var TempPtr: Pointer);
|
||||||
|
Type TBuffRec = Record
|
||||||
|
BytesIn : SmallWord; { Number of bytes in the buffer }
|
||||||
|
MaxSize : SmallWord; { Full size of the buffer }
|
||||||
|
end; { TBuffRec }
|
||||||
|
|
||||||
|
var Available : Boolean;
|
||||||
|
BytesRead : Longint;
|
||||||
|
BlockLen : Longint;
|
||||||
|
ReturnCode: Longint;
|
||||||
|
BufferRec : TBuffRec;
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
if DoRxEvent.WaitForEvent(ReadTimeOut) then
|
||||||
|
if NOT EndThreads then
|
||||||
|
begin
|
||||||
|
CriticalRx.EnterExclusive;
|
||||||
|
ReturnCode := 0;
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_GetInQueCount, { Function }
|
||||||
|
nil, { Params }
|
||||||
|
ReturnCode, { Max param length }
|
||||||
|
@ReturnCode, { Param Length }
|
||||||
|
@BufferRec, { Returned data }
|
||||||
|
SizeOf(TBuffRec), { Max data length }
|
||||||
|
@ReturnCode); { Data length }
|
||||||
|
|
||||||
|
Available := (BufferRec.BytesIn > 00);
|
||||||
|
|
||||||
|
DoRxEvent.ResetEvent;
|
||||||
|
|
||||||
|
if Available then
|
||||||
|
begin
|
||||||
|
{----------- Start reading the gathered date -------------------}
|
||||||
|
|
||||||
|
if InBuffer^.BufRoom > 0 then
|
||||||
|
begin
|
||||||
|
BlockLen := BufferRec.BytesIn;
|
||||||
|
if BlockLen > InBuffer^.BufRoom then
|
||||||
|
BlockLen := InBuffer^.BufRoom;
|
||||||
|
if BlockLen > 1024 then
|
||||||
|
BlockLen := 1024;
|
||||||
|
|
||||||
|
if BlockLen > 00 then
|
||||||
|
begin
|
||||||
|
DosRead(ClientHandle,
|
||||||
|
InBuffer^.TmpBuf,
|
||||||
|
BlockLen,
|
||||||
|
BytesRead);
|
||||||
|
|
||||||
|
InBuffer^.Put(InBuffer^.TmpBuf, BytesRead);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
end; { if }
|
||||||
|
end; { if available }
|
||||||
|
|
||||||
|
CriticalRx.LeaveExclusive;
|
||||||
|
end; { if RxEvent }
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
RxClosedEvent.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. ComReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_WriteProc(var TempPtr: Pointer);
|
||||||
|
var BlockLen : Longint;
|
||||||
|
Written : Longint;
|
||||||
|
ReturnCode : Longint;
|
||||||
|
TempBuf : ^CharBufType;
|
||||||
|
begin
|
||||||
|
New(TempBuf);
|
||||||
|
|
||||||
|
repeat
|
||||||
|
if DoTxEvent.WaitForEvent(WriteTimeOut) then
|
||||||
|
if NOT EndThreads then
|
||||||
|
begin
|
||||||
|
CriticalTx.EnterExclusive;
|
||||||
|
DoTxEvent.ResetEvent;
|
||||||
|
|
||||||
|
if OutBuffer^.BufUsed > 00 then
|
||||||
|
begin
|
||||||
|
Written := 00;
|
||||||
|
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false);
|
||||||
|
|
||||||
|
DosWrite(ClientHandle,
|
||||||
|
OutBuffer^.TmpBuf,
|
||||||
|
BlockLen,
|
||||||
|
Written);
|
||||||
|
|
||||||
|
ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true);
|
||||||
|
if Written <> BlockLen then
|
||||||
|
DoTxEvent.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalTx.LeaveExclusive;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
Dispose(TempBuf);
|
||||||
|
TxClosedEvent.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. ComWriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_StartThread: Boolean;
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
EndThreads := false;
|
||||||
|
if ThreadsInitted then EXIT;
|
||||||
|
ThreadsInitted := true;
|
||||||
|
|
||||||
|
{----------------------- Create all the events ----------------------------}
|
||||||
|
New(DoTxEvent, Init);
|
||||||
|
if NOT DoTxEvent.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(DoRxEvent, Init);
|
||||||
|
if NOT DoRxEvent.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(RxClosedEvent, Init);
|
||||||
|
if NOT RxClosedEvent.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(TxClosedEvent, Init);
|
||||||
|
if NOT TxClosedEvent.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
|
||||||
|
{-------------- Startup the buffers and overlapped events -----------------}
|
||||||
|
New(InBuffer, Init(InBufSize));
|
||||||
|
New(OutBuffer, Init(OutBufSize));
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate write thread ---------------------}
|
||||||
|
New(CriticalTx, Init);
|
||||||
|
CriticalTx.CreateExclusive;
|
||||||
|
|
||||||
|
New(TxThread, Init);
|
||||||
|
if NOT TxThread.CreateThread(16384, { Stack size }
|
||||||
|
WriteProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate read thread ----------------------}
|
||||||
|
New(CriticalRx, Init);
|
||||||
|
CriticalRx.CreateExclusive;
|
||||||
|
|
||||||
|
New(RxThread, Init);
|
||||||
|
if NOT RxThread.CreateThread(16384, { Stack size }
|
||||||
|
ReadProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
Result := true;
|
||||||
|
end; { proc. Com_StartThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_InitVars;
|
||||||
|
begin
|
||||||
|
DoTxEvent := nil;
|
||||||
|
DoRxEvent := nil;
|
||||||
|
RxClosedEvent := nil;
|
||||||
|
TxClosedEvent := nil;
|
||||||
|
TxThread := nil;
|
||||||
|
RxThread := nil;
|
||||||
|
|
||||||
|
InBuffer := nil;
|
||||||
|
OutBuffer := nil;
|
||||||
|
CriticalRx := nil;
|
||||||
|
CriticalTx := nil;
|
||||||
|
end; { proc. Com_InitVars }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_StopThread;
|
||||||
|
begin
|
||||||
|
EndThreads := true;
|
||||||
|
ThreadsInitted := false;
|
||||||
|
|
||||||
|
if DoTxEvent <> nil then DoTxEvent.SignalEvent;
|
||||||
|
if DoTxEvent <> nil then DoRxEvent.SignalEvent;
|
||||||
|
|
||||||
|
|
||||||
|
if TxThread <> nil then TxThread.CloseThread;
|
||||||
|
if RxThread <> nil then RxThread.CloseThread;
|
||||||
|
|
||||||
|
if TxClosedEvent <> nil then
|
||||||
|
if NOT TxClosedEvent^.WaitForEvent(1000) then
|
||||||
|
TxThread.TerminateThread(0);
|
||||||
|
|
||||||
|
if RxClosedEvent <> nil then
|
||||||
|
if NOT RxClosedEvent^.WaitForEvent(1000) then
|
||||||
|
RxThread.TerminateThread(0);
|
||||||
|
|
||||||
|
if TxThread <> nil then TxThread.Done;
|
||||||
|
if RxThread <> nil then RxThread.Done;
|
||||||
|
|
||||||
|
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
|
||||||
|
if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
|
||||||
|
if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
|
||||||
|
if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done);
|
||||||
|
|
||||||
|
if CriticalTx <> nil then Dispose(CriticalTx, Done);
|
||||||
|
if CriticalRx <> nil then Dispose(CriticalRx, Done);
|
||||||
|
|
||||||
|
if InBuffer <> nil then Dispose(InBuffer, Done);
|
||||||
|
if OutBuffer <> nil then Dispose(OutBuffer, Done);
|
||||||
|
|
||||||
|
Com_InitVars;
|
||||||
|
end; { proc. Com_StopThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_GetHandle: Longint;
|
||||||
|
begin
|
||||||
|
Result := ClientHandle;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_OpenQuick(Handle: Longint);
|
||||||
|
begin
|
||||||
|
ClientHandle := Handle;
|
||||||
|
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
end; { proc. TOs2Obj.Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
var ReturnCode: Longint;
|
||||||
|
OpenAction: Longint;
|
||||||
|
Temp : Array[0..15] of Char;
|
||||||
|
begin
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
|
||||||
|
if NOT InitFailed then
|
||||||
|
begin
|
||||||
|
OpenAction := file_Open;
|
||||||
|
StrpCopy(Temp, 'COM' + IntToStr(ComPort));
|
||||||
|
|
||||||
|
ReturnCode :=
|
||||||
|
DosOpen(Temp, { Filename, eg: COM2 }
|
||||||
|
ClientHandle,
|
||||||
|
OpenAction,
|
||||||
|
0, { Filesize }
|
||||||
|
0, { Attributes }
|
||||||
|
FILE_OPEN or OPEN_ACTION_OPEN_IF_EXISTS, { Open flags }
|
||||||
|
OPEN_ACCESS_READWRITE or OPEN_SHARE_DENYNONE or { OpenMode }
|
||||||
|
OPEN_FLAGS_FAIL_ON_ERROR,
|
||||||
|
nil); { Extended attributes }
|
||||||
|
|
||||||
|
InitFailed := (ReturnCode <> 0);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Com_OpenKeep := NOT InitFailed;
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
InitFailed := true;
|
||||||
|
|
||||||
|
if Com_OpenKeep(Comport) then
|
||||||
|
begin
|
||||||
|
Com_SetLine(BaudRate, Parity, DataBits, StopBits);
|
||||||
|
|
||||||
|
InitFailed := false;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Com_Open := NOT InitFailed;
|
||||||
|
end; { func. TOs2Obj.Com_OpenCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
type TBpsRec = Record
|
||||||
|
Rate : Longint;
|
||||||
|
Frac : Byte;
|
||||||
|
end; { record }
|
||||||
|
|
||||||
|
var TempRec : Array[1..3] of Byte;
|
||||||
|
BpsRec : TBpsRec;
|
||||||
|
RetLength : Longint;
|
||||||
|
Temp_Parity : Byte;
|
||||||
|
Temp_StopBits: Byte;
|
||||||
|
begin
|
||||||
|
if NOT (DataBits in [5,7,8]) then DataBits := 8;
|
||||||
|
if NOT (Parity in ['O', 'E', 'N', 'M', 'S']) then Parity := 'N';
|
||||||
|
if NOT (StopBits in [0..2]) then StopBits := 1;
|
||||||
|
|
||||||
|
Temp_Parity := 00;
|
||||||
|
Case Parity of
|
||||||
|
'N' : Temp_Parity := 00;
|
||||||
|
'O' : Temp_Parity := 01;
|
||||||
|
'E' : Temp_Parity := 02;
|
||||||
|
'M' : Temp_Parity := 03;
|
||||||
|
'S' : Temp_Parity := 04;
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
Temp_Stopbits := 00;
|
||||||
|
Case StopBits of
|
||||||
|
1 : StopBits := 0;
|
||||||
|
2 : StopBits := 2;
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
Fillchar(TempRec, SizeOf(TempRec), 00);
|
||||||
|
TempRec[01] := DataBits;
|
||||||
|
TempRec[02] := Temp_Parity;
|
||||||
|
TempRec[03] := Temp_StopBits;
|
||||||
|
|
||||||
|
{------------------------- Set line parameters ----------------------------}
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_SetLineCtrl, { Function }
|
||||||
|
@TempRec, { Params }
|
||||||
|
SizeOf(TempRec), { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
@TempRec, { Returned data }
|
||||||
|
SizeOf(TempRec), { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
|
||||||
|
{------------------------- Set speed parameters ---------------------------}
|
||||||
|
BpsRec.Rate := BpsRate;
|
||||||
|
BpsRec.Frac := 00;
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_ExtSetBaudRate, { Function }
|
||||||
|
@BpsRec, { Params }
|
||||||
|
SizeOf(BpsRec), { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
@BpsRec, { Returned data }
|
||||||
|
SizeOf(BpsRec), { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
end; { proc. TOs2Obj.Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_Close;
|
||||||
|
begin
|
||||||
|
if DontClose then EXIT;
|
||||||
|
|
||||||
|
if ClientHandle <> -1 then
|
||||||
|
begin
|
||||||
|
Com_StopThread;
|
||||||
|
DosClose(ClientHandle);
|
||||||
|
|
||||||
|
ClientHandle := -1;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
end; { func. TOs2Obj.Com_CloseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_SendChar(C: Char): Boolean;
|
||||||
|
var Written: Longint;
|
||||||
|
begin
|
||||||
|
Com_SendBlock(C, SizeOf(C), Written);
|
||||||
|
Com_SendChar := (Written = SizeOf(c));
|
||||||
|
end; { proc. TOs2Obj.Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_GetChar: Char;
|
||||||
|
var Reads: Longint;
|
||||||
|
begin
|
||||||
|
Com_ReadBlock(Result, SizeOf(Result), Reads);
|
||||||
|
end; { func. TOs2Obj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
begin
|
||||||
|
if OutBuffer^.BufRoom < BlockLen then
|
||||||
|
repeat
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosSleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
|
||||||
|
CriticalTx.EnterExclusive;
|
||||||
|
Written := OutBuffer^.Put(Block, BlockLen);
|
||||||
|
CriticalTx.LeaveExclusive;
|
||||||
|
|
||||||
|
DoTxEvent.SignalEvent;
|
||||||
|
end; { proc. TOs2Obj.Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < BlockLen then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
if Com_CharAvail then
|
||||||
|
DoRxEvent.SignalEvent;
|
||||||
|
|
||||||
|
DosSleep(1);
|
||||||
|
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalRx.EnterExclusive;
|
||||||
|
Reads := InBuffer^.Get(Block, BlockLen, true);
|
||||||
|
CriticalRx.LeaveExclusive;
|
||||||
|
end; { proc. TOs2Obj.Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_CharAvail: Boolean;
|
||||||
|
|
||||||
|
Type TBuffRec = Record
|
||||||
|
BytesIn : SmallWord; { Number of bytes in the buffer }
|
||||||
|
MaxSize : SmallWord; { Full size of the buffer }
|
||||||
|
end; { TBuffRec }
|
||||||
|
|
||||||
|
var ReturnCode: Longint;
|
||||||
|
BufferRec : TBuffRec;
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < 1 then
|
||||||
|
begin
|
||||||
|
ReturnCode := 0;
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_GetInQueCount, { Function }
|
||||||
|
nil, { Params }
|
||||||
|
ReturnCode, { Max param length }
|
||||||
|
@ReturnCode, { Param Length }
|
||||||
|
@BufferRec, { Returned data }
|
||||||
|
SizeOf(TBuffRec), { Max data length }
|
||||||
|
@ReturnCode); { Data length }
|
||||||
|
|
||||||
|
if (BufferRec.BytesIn > 0) then
|
||||||
|
DoRxEvent.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Result := (InBuffer^.BufUsed > 0);
|
||||||
|
end; { func. TOs2Obj.Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_Carrier: Boolean;
|
||||||
|
var Status : Byte;
|
||||||
|
RetLength : Longint;
|
||||||
|
begin
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_GetModemInput, { Function }
|
||||||
|
nil, { Params }
|
||||||
|
00, { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
@Status, { Returned data }
|
||||||
|
SizeOf(Status), { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
|
||||||
|
Com_Carrier := Status AND 128 <> 00;
|
||||||
|
end; { func. TOs2Obj.Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
begin
|
||||||
|
LineStatus := 00;
|
||||||
|
ModemStatus := 08;
|
||||||
|
|
||||||
|
if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7);
|
||||||
|
end; { proc. TOs2Obj.Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_SetDtr(State: Boolean);
|
||||||
|
type
|
||||||
|
TRtsDtrRec = record
|
||||||
|
Onmask,
|
||||||
|
Offmask : Byte;
|
||||||
|
end; { record }
|
||||||
|
|
||||||
|
var MaskRec : TRtsDtrRec;
|
||||||
|
RetLength : Longint;
|
||||||
|
begin
|
||||||
|
if State then
|
||||||
|
begin
|
||||||
|
MaskRec.OnMask := $01;
|
||||||
|
MaskRec.OffMask := $FF;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
MaskRec.OnMask := $00;
|
||||||
|
MaskRec.OffMask := $FE;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_SetModemCtrl, { Function }
|
||||||
|
@MaskRec, { Params }
|
||||||
|
SizeOf(MaskRec), { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
@MaskRec, { Returned data }
|
||||||
|
SizeOf(MaskRec), { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
end; { proc. TOs2Obj.Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TOs2Obj.Com_GetBpsRate: Longint;
|
||||||
|
type
|
||||||
|
TBpsRec = record
|
||||||
|
CurBaud : Longint; { Current BaudRate }
|
||||||
|
CurFrac : Byte; { Current Fraction }
|
||||||
|
MinBaud : Longint; { Minimum BaudRate }
|
||||||
|
MinFrac : Byte; { Minimum Fraction }
|
||||||
|
MaxBaud : Longint; { Maximum BaudRate }
|
||||||
|
MaxFrac : Byte; { Maximum Fraction }
|
||||||
|
end; { TBpsRec }
|
||||||
|
|
||||||
|
var BpsRec : TBpsRec;
|
||||||
|
Status : Byte;
|
||||||
|
RetLength: Longint;
|
||||||
|
begin
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_ExtGetBaudRate, { Function }
|
||||||
|
nil, { Params }
|
||||||
|
00, { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
@BpsRec, { Returned data }
|
||||||
|
SizeOf(BpsRec), { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
|
||||||
|
Com_GetBpsRate := BpsRec.CurBaud;
|
||||||
|
end; { func. TOs2Obj.Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
begin
|
||||||
|
DoRxEvent.SignalEvent;
|
||||||
|
DoTxEvent.SignalEvent;
|
||||||
|
|
||||||
|
InFree := InBuffer^.BufRoom;
|
||||||
|
OutFree := OutBuffer^.BufRoom;
|
||||||
|
InUsed := InBuffer^.BufUsed;
|
||||||
|
OutUsed := OutBuffer^.BufUsed;
|
||||||
|
end; { proc. TOs2Obj.Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
CriticalRx.EnterExclusive;
|
||||||
|
|
||||||
|
InBuffer^.Clear;
|
||||||
|
|
||||||
|
CriticalRx.LeaveExclusive;
|
||||||
|
end; { proc. TOs2Obj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
CriticalTx.EnterExclusive;
|
||||||
|
|
||||||
|
OutBuffer^.Clear;
|
||||||
|
|
||||||
|
CriticalTx.LeaveExclusive;
|
||||||
|
end; { proc. TOs2Obj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_FlushOutBuffer(Slice: SliceProc);
|
||||||
|
begin
|
||||||
|
DosResetBuffer(ClientHandle);
|
||||||
|
|
||||||
|
inherited Com_FlushOutBuffer(Slice);
|
||||||
|
end; { proc. Com_FlushOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
|
||||||
|
function TOs2Obj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Result := OutBuffer^.BufRoom >= BlockLen;
|
||||||
|
end; { func. ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_PauseCom(CloseCom: Boolean);
|
||||||
|
begin
|
||||||
|
if CloseCom then Com_Close
|
||||||
|
else Com_StopThread;
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
begin
|
||||||
|
if OpenCom then Com_OpenKeep(0)
|
||||||
|
else Com_StartThread;
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
var Dcb : DCBINFO;
|
||||||
|
RetLength: Longint;
|
||||||
|
begin
|
||||||
|
FillChar(Dcb, SizeOF(Dcb), 0);
|
||||||
|
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_GetDcbInfo, { Function }
|
||||||
|
nil, { Params }
|
||||||
|
00, { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
@Dcb, { Returned data }
|
||||||
|
SizeOf(DcbInfo), { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
|
||||||
|
if (SoftTX) or (SoftRX) then
|
||||||
|
begin
|
||||||
|
dcb.fbFlowReplace := dcb.fbFlowReplace + MODE_AUTO_RECEIVE + MODE_AUTO_TRANSMIT;
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
dcb.fbFlowReplace := MODE_RTS_HANDSHAKE;
|
||||||
|
dcb.fbCtlHndShake := dcb.fbCtlHndShake + MODE_CTS_HANDSHAKE;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
dcb.fbTimeout := MODE_NO_WRITE_TIMEOUT + MODE_WAIT_READ_TIMEOUT;
|
||||||
|
dcb.bXONChar := $11;
|
||||||
|
dcb.bXOFFChar := $13;
|
||||||
|
|
||||||
|
RetLength := SizeOf(DcbInfo);
|
||||||
|
DosDevIoCtl(ClientHandle, { File-handle }
|
||||||
|
ioctl_Async, { Category }
|
||||||
|
async_SetDcbInfo, { Function }
|
||||||
|
@Dcb, { Params }
|
||||||
|
SizeOf(DcbInfo), { Max param length }
|
||||||
|
@RetLength, { Param Length }
|
||||||
|
nil, { Returned data }
|
||||||
|
RetLength, { Max data length }
|
||||||
|
@RetLength); { Data length }
|
||||||
|
|
||||||
|
end; { proc. Com_SetFlow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TOs2Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
||||||
|
begin
|
||||||
|
ReadProcPtr := ReadPtr;
|
||||||
|
WriteProcPtr := WritePtr;
|
||||||
|
end; { proc. Com_SetDataProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,109 @@
|
||||||
|
Procedure overview
|
||||||
|
==================
|
||||||
|
|
||||||
|
+---------------------+---------------+----------------------------------------+
|
||||||
|
| Name | Parameters | Explanation |
|
||||||
|
+---------------------+---------------+----------------------------------------+
|
||||||
|
| Com_OpenQuick | | Open the comport without init. |
|
||||||
|
| | Handle | Use these two handles for quickinit |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_Open | | Opens the connection and set params |
|
||||||
|
| | Comport | Comport to open (COM1 = 1) |
|
||||||
|
| | BaudRate | |
|
||||||
|
| | DataBits, | |
|
||||||
|
| | Parity | |
|
||||||
|
| | StopBits | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_Openkeep | | Open the comport without setting params|
|
||||||
|
| | Comport | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_GetModemStatus | | Get the line/modem parameters |
|
||||||
|
| | LineStatus | |
|
||||||
|
| | ModemStatus | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SetLine | | Set the comm. parameters |
|
||||||
|
| | BPSrate | |
|
||||||
|
| | Parity | |
|
||||||
|
| | DataBits | |
|
||||||
|
| | StopBits | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_GetBPSrate | | Returns the current line-speed |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_GetBufferStatus | | Get the current buffer statusses |
|
||||||
|
| | InFree | Bytes free in input buffer |
|
||||||
|
| | OutFree | Bytes free in output buffer |
|
||||||
|
| | InUsed | Bytes currently used in input buffer |
|
||||||
|
| | OutUsed | Bytes currently used in output buffer |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SetDTR | | Set DTR setting |
|
||||||
|
| | State |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_CharAvail | | Returns TRUE if there's a char avail. |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_Carrier | | Returns TRUE if the DTR signal is high |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_ReadyToSend | | Room enough for this block? |
|
||||||
|
| | Blocklen | Number of bytes we want to send |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_GetChar | | Get one character from the input buffer|
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SendChar | | Send one character to the remote |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_GetDriverInfo | | Returns the driver info (FOSSIL only) |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_GetHandle | | Get the current used handle |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_InitSucceeded | | Returns TRUE if the initialization |
|
||||||
|
| | | succeeded |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_Close | | Closes the comport and stop the |
|
||||||
|
| | | threads |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SendBlock | | Sends a block to the remote. |
|
||||||
|
| | Block | Warning: Make sure that the block you |
|
||||||
|
| | BlockLen | send isn't larger than the |
|
||||||
|
| | Written | available buffer size, else |
|
||||||
|
| | | this routine will block |
|
||||||
|
| | | indefinitaly |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SendWait | | Sends a block to the remote, this |
|
||||||
|
| | Block | routine will wait till all the size is |
|
||||||
|
| | BlockLen | sent under FOSSIL, else it's the same |
|
||||||
|
| | Written | as Com_SendBlock. |
|
||||||
|
| | Slice | Slice is called when waiting for all to|
|
||||||
|
| | | get out. |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_ReadBlock | | Gets a block from the remote |
|
||||||
|
| | Block | Block to read into |
|
||||||
|
| | BlockLen | Amount of bytes we want (will block!) |
|
||||||
|
| | Reads | Amount of bytes we actually gotten |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_PurgeOutBuffer | | Kill all the pending output |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_PurgeInBuffer | | Kill all the pending input |
|
||||||
|
| | | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_PauseCom | | Pause the communications. Stop threads |
|
||||||
|
| | CloseCom |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_ResumeCom | | Resums communications. Start threads |
|
||||||
|
| | CloseCom | |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_FlushOutBuffer | | Wait till all pending output is done |
|
||||||
|
| | SliceProc | Procedure is called while waiting.. |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SendString | | Send this string to the remote |
|
||||||
|
| | Temp | String to send |
|
||||||
|
+------------------------------------------------------------------------------+
|
||||||
|
| Com_SetDataProc | | Set read/write thread handlers |
|
||||||
|
| | ReadPtr | Pointer to read thread procedure |
|
||||||
|
| | WritePtr | Pointer to write thread procedure |
|
||||||
|
+----------------------------------------------------(c)2000 by Maarten Bekers-+
|
|
@ -0,0 +1,17 @@
|
||||||
|
ELECOM v1.03 - release notes
|
||||||
|
============================
|
||||||
|
|
||||||
|
These communication routines are released as freeware. You are free to do with
|
||||||
|
these routines whatever you want, but please give me proper credit when you do
|
||||||
|
use them (a small email to me mentioning that you are using them would be
|
||||||
|
great as well).
|
||||||
|
|
||||||
|
When you make any changes, enhancements or additions, please send me a copy
|
||||||
|
of the changes so I can include them in the next release.
|
||||||
|
|
||||||
|
Have fun,
|
||||||
|
|
||||||
|
groeten, Maarten Bekers
|
||||||
|
|
||||||
|
website: www.elebbs.com
|
||||||
|
email : maarten@elebbs.com
|
|
@ -0,0 +1,606 @@
|
||||||
|
unit SockDef;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** SOCKDEF routines
|
||||||
|
**
|
||||||
|
** Copyright (c) 1998 by Thomas W. Mueller
|
||||||
|
**
|
||||||
|
** Created : 24-Oct-1998
|
||||||
|
** Last update : 24-Oct-1998
|
||||||
|
**
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses
|
||||||
|
Sysutils,
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Os2def;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Linux;
|
||||||
|
{$ENDIF}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Windows;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
{$IFDEF VER0_99_13}
|
||||||
|
type pInteger = ^Integer;
|
||||||
|
tFarProc = pointer;
|
||||||
|
SmallInt = System.Integer;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
type ULONG = longint;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
tSockDesc = LongInt;
|
||||||
|
SmallWord = System.Word;
|
||||||
|
|
||||||
|
type
|
||||||
|
eSocketErr = class(Exception);
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
const
|
||||||
|
MaxHostNameLen = 120;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Option flags per-socket.
|
||||||
|
*)
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
(*
|
||||||
|
** Level number for (get/set)sockopt() to apply to socket itself.
|
||||||
|
*)
|
||||||
|
SOL_SOCKET =$ffff; // options for socket level
|
||||||
|
|
||||||
|
SO_DEBUG =$0001; // turn on debugging info recording
|
||||||
|
SO_ACCEPTCONN =$0002; // socket has had listen()
|
||||||
|
SO_REUSEADDR =$0004; // allow local address reuse
|
||||||
|
SO_KEEPALIVE =$0008; // keep connections alive
|
||||||
|
SO_DONTROUTE =$0010; // just use interface addresses
|
||||||
|
SO_BROADCAST =$0020; // permit sending of broadcast msgs
|
||||||
|
SO_USELOOPBACK =$0040; // bypass hardware when possible
|
||||||
|
SO_LINGER =$0080; // linger on close if data present
|
||||||
|
SO_OOBINLINE =$0100; // leave received OOB data in line
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Additional options, not kept in so_options.
|
||||||
|
*)
|
||||||
|
SO_SNDBUF =$1001; // send buffer size
|
||||||
|
SO_RCVBUF =$1002; // receive buffer size
|
||||||
|
SO_SNDLOWAT =$1003; // send low-water mark
|
||||||
|
SO_RCVLOWAT =$1004; // receive low-water mark
|
||||||
|
SO_SNDTIMEO =$1005; // send timeout
|
||||||
|
SO_RCVTIMEO =$1006; // receive timeout
|
||||||
|
SO_ERROR =$1007; // get error status and clear
|
||||||
|
SO_TYPE =$1008; // get socket type
|
||||||
|
|
||||||
|
{$ELSE}
|
||||||
|
SOL_SOCKET = 1;
|
||||||
|
|
||||||
|
SO_DEBUG = 1;
|
||||||
|
SO_REUSEADDR = 2;
|
||||||
|
SO_TYPE = 3;
|
||||||
|
SO_ERROR = 4;
|
||||||
|
SO_DONTROUTE = 5;
|
||||||
|
SO_BROADCAST = 6;
|
||||||
|
SO_SNDBUF = 7;
|
||||||
|
SO_RCVBUF = 8;
|
||||||
|
SO_KEEPALIVE = 9;
|
||||||
|
SO_OOBINLINE = 10;
|
||||||
|
SO_NO_CHECK = 11;
|
||||||
|
SO_PRIORITY = 12;
|
||||||
|
SO_LINGER = 13;
|
||||||
|
SO_BSDCOMPAT = 14;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Address families.
|
||||||
|
*)
|
||||||
|
AF_UNSPEC = 0; // unspecified
|
||||||
|
AF_UNIX = 1; // local to host (pipes, portals)
|
||||||
|
AF_INET = 2; // internetwork: UDP, TCP, etc.
|
||||||
|
AF_IMPLINK = 3; // arpanet imp addresses
|
||||||
|
AF_PUP = 4; // pup protocols: e.g. BSP
|
||||||
|
AF_CHAOS = 5; // mit CHAOS protocols
|
||||||
|
AF_NS = 6; // XEROX NS protocols
|
||||||
|
AF_NBS = 7; // nbs protocols
|
||||||
|
AF_ECMA = 8; // european computer manufacturers
|
||||||
|
AF_DATAKIT = 9; // datakit protocols
|
||||||
|
AF_CCITT = 10; // CCITT protocols, X.25 etc
|
||||||
|
AF_SNA = 11; // IBM SNA
|
||||||
|
AF_DECnet = 12; // DECnet
|
||||||
|
AF_DLI = 13; // Direct data link interface
|
||||||
|
AF_LAT = 14; // LAT
|
||||||
|
AF_HYLINK = 15; // NSC Hyperchannel
|
||||||
|
AF_APPLETALK = 16; // Apple Talk
|
||||||
|
|
||||||
|
AF_OS2 = AF_UNIX;
|
||||||
|
|
||||||
|
AF_NB = 17; // Netbios
|
||||||
|
AF_NETBIOS = AF_NB;
|
||||||
|
|
||||||
|
AF_MAX = 18;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Protocol families, same as address families for now.
|
||||||
|
*)
|
||||||
|
PF_UNSPEC = AF_UNSPEC;
|
||||||
|
PF_UNIX = AF_UNIX;
|
||||||
|
PF_INET = AF_INET;
|
||||||
|
PF_IMPLINK = AF_IMPLINK;
|
||||||
|
PF_PUP = AF_PUP;
|
||||||
|
PF_CHAOS = AF_CHAOS;
|
||||||
|
PF_NS = AF_NS;
|
||||||
|
PF_NBS = AF_NBS;
|
||||||
|
PF_ECMA = AF_ECMA;
|
||||||
|
PF_DATAKIT = AF_DATAKIT;
|
||||||
|
PF_CCITT = AF_CCITT;
|
||||||
|
PF_SNA = AF_SNA;
|
||||||
|
PF_DECnet = AF_DECnet;
|
||||||
|
PF_DLI = AF_DLI;
|
||||||
|
PF_LAT = AF_LAT;
|
||||||
|
PF_HYLINK = AF_HYLINK;
|
||||||
|
PF_APPLETALK = AF_APPLETALK;
|
||||||
|
PF_NETBIOS = AF_NB;
|
||||||
|
PF_NB = AF_NB;
|
||||||
|
PF_OS2 = PF_UNIX;
|
||||||
|
PF_MAX = AF_MAX;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Maximum queue length specifiable by listen.
|
||||||
|
*)
|
||||||
|
|
||||||
|
SOMAXCONN = 5;
|
||||||
|
|
||||||
|
FREAD =1;
|
||||||
|
FWRITE =2;
|
||||||
|
|
||||||
|
MSG_OOB =$1; // process out-of-band data
|
||||||
|
MSG_PEEK =$2; // peek at incoming message
|
||||||
|
MSG_DONTROUTE =$4; // send without using routing tables
|
||||||
|
MSG_FULLREAD =$8; // send without using routing tables
|
||||||
|
|
||||||
|
MSG_MAXIOVLEN =16;
|
||||||
|
|
||||||
|
const
|
||||||
|
{ All Windows Sockets error constants are biased by WSABASEERR from the "normal" }
|
||||||
|
|
||||||
|
WSABASEERR = 10000;
|
||||||
|
|
||||||
|
{ Windows Sockets definitions of regular Microsoft C error constants }
|
||||||
|
|
||||||
|
WSAEINTR = (WSABASEERR+4);
|
||||||
|
WSAEBADF = (WSABASEERR+9);
|
||||||
|
WSAEACCES = (WSABASEERR+13);
|
||||||
|
WSAEFAULT = (WSABASEERR+14);
|
||||||
|
WSAEINVAL = (WSABASEERR+22);
|
||||||
|
WSAEMFILE = (WSABASEERR+24);
|
||||||
|
|
||||||
|
{ Windows Sockets definitions of regular Berkeley error constants }
|
||||||
|
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
WSAEWOULDBLOCK = (WSABASEERR+35);
|
||||||
|
WSAEINPROGRESS = (WSABASEERR+36);
|
||||||
|
WSAEALREADY = (WSABASEERR+37);
|
||||||
|
WSAENOTSOCK = (WSABASEERR+38);
|
||||||
|
WSAEDESTADDRREQ = (WSABASEERR+39);
|
||||||
|
WSAEMSGSIZE = (WSABASEERR+40);
|
||||||
|
WSAEPROTOTYPE = (WSABASEERR+41);
|
||||||
|
WSAENOPROTOOPT = (WSABASEERR+42);
|
||||||
|
WSAEPROTONOSUPPORT = (WSABASEERR+43);
|
||||||
|
WSAESOCKTNOSUPPORT = (WSABASEERR+44);
|
||||||
|
WSAEOPNOTSUPP = (WSABASEERR+45);
|
||||||
|
WSAEPFNOSUPPORT = (WSABASEERR+46);
|
||||||
|
WSAEAFNOSUPPORT = (WSABASEERR+47);
|
||||||
|
WSAEADDRINUSE = (WSABASEERR+48);
|
||||||
|
WSAEADDRNOTAVAIL = (WSABASEERR+49);
|
||||||
|
WSAENETDOWN = (WSABASEERR+50);
|
||||||
|
WSAENETUNREACH = (WSABASEERR+51);
|
||||||
|
WSAENETRESET = (WSABASEERR+52);
|
||||||
|
WSAECONNABORTED = (WSABASEERR+53);
|
||||||
|
WSAECONNRESET = (WSABASEERR+54);
|
||||||
|
WSAENOBUFS = (WSABASEERR+55);
|
||||||
|
WSAEISCONN = (WSABASEERR+56);
|
||||||
|
WSAENOTCONN = (WSABASEERR+57);
|
||||||
|
WSAESHUTDOWN = (WSABASEERR+58);
|
||||||
|
WSAETOOMANYREFS = (WSABASEERR+59);
|
||||||
|
WSAETIMEDOUT = (WSABASEERR+60);
|
||||||
|
WSAECONNREFUSED = (WSABASEERR+61);
|
||||||
|
WSAELOOP = (WSABASEERR+62);
|
||||||
|
WSAENAMETOOLONG = (WSABASEERR+63);
|
||||||
|
WSAEHOSTDOWN = (WSABASEERR+64);
|
||||||
|
WSAEHOSTUNREACH = (WSABASEERR+65);
|
||||||
|
WSAENOTEMPTY = (WSABASEERR+66);
|
||||||
|
WSAEPROCLIM = (WSABASEERR+67);
|
||||||
|
WSAEUSERS = (WSABASEERR+68);
|
||||||
|
WSAEDQUOT = (WSABASEERR+69);
|
||||||
|
WSAESTALE = (WSABASEERR+70);
|
||||||
|
WSAEREMOTE = (WSABASEERR+71);
|
||||||
|
|
||||||
|
WSAEDISCON = (WSABASEERR+101);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
WSAEWOULDBLOCK = 11;
|
||||||
|
WSAEINPROGRESS = 115;
|
||||||
|
WSAEALREADY = 114;
|
||||||
|
WSAENOTSOCK = 88;
|
||||||
|
WSAEDESTADDRREQ = 89;
|
||||||
|
WSAEMSGSIZE = 90;
|
||||||
|
WSAEPROTOTYPE = 91;
|
||||||
|
WSAENOPROTOOPT = 92;
|
||||||
|
WSAEPROTONOSUPPORT = 93;
|
||||||
|
WSAESOCKTNOSUPPORT = 94;
|
||||||
|
WSAEOPNOTSUPP = 95;
|
||||||
|
WSAEPFNOSUPPORT = 96;
|
||||||
|
WSAEAFNOSUPPORT = 97;
|
||||||
|
WSAEADDRINUSE = 98;
|
||||||
|
WSAEADDRNOTAVAIL = 99;
|
||||||
|
WSAENETDOWN = 100;
|
||||||
|
WSAENETUNREACH = 101;
|
||||||
|
WSAENETRESET = 102;
|
||||||
|
WSAECONNABORTED = 103;
|
||||||
|
WSAECONNRESET = 104;
|
||||||
|
WSAENOBUFS = 105;
|
||||||
|
WSAEISCONN = 106;
|
||||||
|
WSAENOTCONN = 107;
|
||||||
|
WSAESHUTDOWN = 108;
|
||||||
|
WSAETOOMANYREFS = 109;
|
||||||
|
WSAETIMEDOUT = 110;
|
||||||
|
WSAECONNREFUSED = 111;
|
||||||
|
WSAELOOP = 40;
|
||||||
|
WSAENAMETOOLONG = 36;
|
||||||
|
WSAEHOSTDOWN = 112;
|
||||||
|
WSAEHOSTUNREACH = 113;
|
||||||
|
WSAENOTEMPTY = 39;
|
||||||
|
WSAEPROCLIM = 00;
|
||||||
|
WSAEUSERS = 87;
|
||||||
|
WSAEDQUOT = 122;
|
||||||
|
WSAESTALE = 116;
|
||||||
|
WSAEREMOTE = 66;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{ Extended Windows Sockets error constant definitions }
|
||||||
|
|
||||||
|
WSASYSNOTREADY = (WSABASEERR+91);
|
||||||
|
WSAVERNOTSUPPORTED = (WSABASEERR+92);
|
||||||
|
WSANOTINITIALISED = (WSABASEERR+93);
|
||||||
|
|
||||||
|
{ Error return codes from gethostbyname() and gethostbyaddr()
|
||||||
|
(when using the resolver). Note that these errors are
|
||||||
|
retrieved via WSAGetLastError() and must therefore follow
|
||||||
|
the rules for avoiding clashes with error numbers from
|
||||||
|
specific implementations or language run-time systems.
|
||||||
|
For this reason the codes are based at WSABASEERR+1001.
|
||||||
|
Note also that [WSA]NO_ADDRESS is defined only for
|
||||||
|
compatibility purposes. }
|
||||||
|
|
||||||
|
{ Authoritative Answer: Host not found }
|
||||||
|
|
||||||
|
WSAHOST_NOT_FOUND = (WSABASEERR+1001);
|
||||||
|
HOST_NOT_FOUND = WSAHOST_NOT_FOUND;
|
||||||
|
|
||||||
|
{ Non-Authoritative: Host not found, or SERVERFAIL }
|
||||||
|
|
||||||
|
WSATRY_AGAIN = (WSABASEERR+1002);
|
||||||
|
TRY_AGAIN = WSATRY_AGAIN;
|
||||||
|
|
||||||
|
{ Non recoverable errors, FORMERR, REFUSED, NOTIMP }
|
||||||
|
|
||||||
|
WSANO_RECOVERY = (WSABASEERR+1003);
|
||||||
|
NO_RECOVERY = WSANO_RECOVERY;
|
||||||
|
|
||||||
|
{ Valid name, no data record of requested type }
|
||||||
|
|
||||||
|
WSANO_DATA = (WSABASEERR+1004);
|
||||||
|
NO_DATA = WSANO_DATA;
|
||||||
|
|
||||||
|
{ no address, look for MX record }
|
||||||
|
|
||||||
|
WSANO_ADDRESS = WSANO_DATA;
|
||||||
|
NO_ADDRESS = WSANO_ADDRESS;
|
||||||
|
|
||||||
|
{ Windows Sockets errors redefined as regular Berkeley error constants.
|
||||||
|
These are commented out in Windows NT to avoid conflicts with errno.h.
|
||||||
|
Use the WSA constants instead. }
|
||||||
|
|
||||||
|
EWOULDBLOCK = WSAEWOULDBLOCK;
|
||||||
|
EINPROGRESS = WSAEINPROGRESS;
|
||||||
|
EALREADY = WSAEALREADY;
|
||||||
|
ENOTSOCK = WSAENOTSOCK;
|
||||||
|
EDESTADDRREQ = WSAEDESTADDRREQ;
|
||||||
|
EMSGSIZE = WSAEMSGSIZE;
|
||||||
|
EPROTOTYPE = WSAEPROTOTYPE;
|
||||||
|
ENOPROTOOPT = WSAENOPROTOOPT;
|
||||||
|
EPROTONOSUPPORT = WSAEPROTONOSUPPORT;
|
||||||
|
ESOCKTNOSUPPORT = WSAESOCKTNOSUPPORT;
|
||||||
|
EOPNOTSUPP = WSAEOPNOTSUPP;
|
||||||
|
EPFNOSUPPORT = WSAEPFNOSUPPORT;
|
||||||
|
EAFNOSUPPORT = WSAEAFNOSUPPORT;
|
||||||
|
EADDRINUSE = WSAEADDRINUSE;
|
||||||
|
EADDRNOTAVAIL = WSAEADDRNOTAVAIL;
|
||||||
|
ENETDOWN = WSAENETDOWN;
|
||||||
|
ENETUNREACH = WSAENETUNREACH;
|
||||||
|
ENETRESET = WSAENETRESET;
|
||||||
|
ECONNABORTED = WSAECONNABORTED;
|
||||||
|
ECONNRESET = WSAECONNRESET;
|
||||||
|
ENOBUFS = WSAENOBUFS;
|
||||||
|
EISCONN = WSAEISCONN;
|
||||||
|
ENOTCONN = WSAENOTCONN;
|
||||||
|
ESHUTDOWN = WSAESHUTDOWN;
|
||||||
|
ETOOMANYREFS = WSAETOOMANYREFS;
|
||||||
|
ETIMEDOUT = WSAETIMEDOUT;
|
||||||
|
ECONNREFUSED = WSAECONNREFUSED;
|
||||||
|
ELOOP = WSAELOOP;
|
||||||
|
ENAMETOOLONG = WSAENAMETOOLONG;
|
||||||
|
EHOSTDOWN = WSAEHOSTDOWN;
|
||||||
|
EHOSTUNREACH = WSAEHOSTUNREACH;
|
||||||
|
ENOTEMPTY = WSAENOTEMPTY;
|
||||||
|
EPROCLIM = WSAEPROCLIM;
|
||||||
|
EUSERS = WSAEUSERS;
|
||||||
|
EDQUOT = WSAEDQUOT;
|
||||||
|
ESTALE = WSAESTALE;
|
||||||
|
EREMOTE = WSAEREMOTE;
|
||||||
|
|
||||||
|
SockAddr_Len = 16;
|
||||||
|
In_Addr_Len = 4;
|
||||||
|
InAddr_Any = 0;
|
||||||
|
InAddr_Loopback = $7F000001;
|
||||||
|
InAddr_Broadcast = $FFFFFFFF;
|
||||||
|
InAddr_None = $FFFFFFFF;
|
||||||
|
|
||||||
|
SOCK_NULL = 0;
|
||||||
|
SOCK_STREAM = 1; // stream socket
|
||||||
|
SOCK_DGRAM = 2; // datagram socket
|
||||||
|
SOCK_RAW = 3; // raw-protocol interface
|
||||||
|
SOCK_RDM = 4; // reliably-delivered message
|
||||||
|
SOCK_SEQPACKET = 5; // sequenced packet stream
|
||||||
|
|
||||||
|
IPPROTO_NULL = 0;
|
||||||
|
IPPROTO_UDP = 17;
|
||||||
|
IPPROTO_TCP = 6;
|
||||||
|
|
||||||
|
|
||||||
|
const
|
||||||
|
IOCPARM_MASK = $7f;
|
||||||
|
IOC_VOID = $20000000;
|
||||||
|
IOC_OUT = $40000000;
|
||||||
|
IOC_IN = $80000000;
|
||||||
|
IOC_INOUT = (IOC_IN or IOC_OUT);
|
||||||
|
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
FIONREAD = IOC_OUT or { get # bytes to read }
|
||||||
|
((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
|
||||||
|
(Longint(Byte('f')) shl 8) or 127;
|
||||||
|
FIONBIO = IOC_IN or { set/clear non-blocking i/o }
|
||||||
|
((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
|
||||||
|
(Longint(Byte('f')) shl 8) or 126;
|
||||||
|
FIOASYNC = IOC_IN or { set/clear async i/o }
|
||||||
|
((Longint(SizeOf(Longint)) and IOCPARM_MASK) shl 16) or
|
||||||
|
(Longint(Byte('f')) shl 8) or 125;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type
|
||||||
|
pLongInt = ^LongInt;
|
||||||
|
|
||||||
|
pIoVec = ^tIoVec;
|
||||||
|
tIoVec = packed record
|
||||||
|
iov_base: POINTER;
|
||||||
|
iov_len: LongInt;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Structure used for manipulating linger option.
|
||||||
|
*)
|
||||||
|
tLinger = packed record
|
||||||
|
l_onoff: LongInt; // option on/off
|
||||||
|
l_linger: LongInt; // linger time
|
||||||
|
END;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Structure used by kernel to pass protocol
|
||||||
|
** information in raw sockets.
|
||||||
|
*)
|
||||||
|
|
||||||
|
tSockProto = packed record
|
||||||
|
sp_family: WORD; // address family
|
||||||
|
sp_protocol: WORD; // protocol
|
||||||
|
END;
|
||||||
|
|
||||||
|
off_t = LongInt;
|
||||||
|
|
||||||
|
tuio = packed record
|
||||||
|
uio_iov: pIoVec;
|
||||||
|
uio_iovcnt: LongInt;
|
||||||
|
uio_offset: off_t;
|
||||||
|
uio_segflg: LongInt;
|
||||||
|
uio_resid: LongInt;
|
||||||
|
END;
|
||||||
|
|
||||||
|
pIn_Addr = ^tIn_Addr;
|
||||||
|
tIn_Addr = packed record
|
||||||
|
case integer of
|
||||||
|
0: (IPAddr: ULong);
|
||||||
|
1: (ClassA: byte;
|
||||||
|
ClassB: byte;
|
||||||
|
ClassC: byte;
|
||||||
|
ClassD: byte)
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Structure used by kernel to store most
|
||||||
|
** addresses.
|
||||||
|
*)
|
||||||
|
pSockAddr=^tSockAddr;
|
||||||
|
tSockAddr=packed record
|
||||||
|
case integer of
|
||||||
|
0: (Sin_Family: SmallWord;
|
||||||
|
Sin_Port: SmallWord;
|
||||||
|
Sin_Addr: tIn_Addr;
|
||||||
|
Sin_Zero: array[1.. 8] of byte);
|
||||||
|
1: (Sa_Family: SmallWord;
|
||||||
|
Sa_Addr: array[1..14] of byte);
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** Message header for recvmsg and sendmsg calls.
|
||||||
|
*)
|
||||||
|
pMsgHdr = ^tMsgHdr;
|
||||||
|
tMsgHdr = packed record
|
||||||
|
msg_name: pChar; // optional address
|
||||||
|
msg_namelen: LongInt; // size of address
|
||||||
|
msg_iov: pIoVec; // scatter/gather array
|
||||||
|
msg_iovlen: LongInt; // # elements in msg_iov
|
||||||
|
msg_accrights: pChar; // access rights sent/received
|
||||||
|
msg_accrightslen: LongInt;
|
||||||
|
END;
|
||||||
|
|
||||||
|
uio_rw = ( UIO_READ, UIO_WRITE );
|
||||||
|
|
||||||
|
pHostEnt = ^tHostEnt;
|
||||||
|
tHostEnt = packed record
|
||||||
|
H_Name: ^string;
|
||||||
|
H_Alias: pointer;
|
||||||
|
{$IFNDEF WIN32}
|
||||||
|
H_AddrType: longint;
|
||||||
|
H_Length: longint;
|
||||||
|
{$ELSE}
|
||||||
|
h_addrtype: Smallint;
|
||||||
|
h_length: Smallint;
|
||||||
|
{$ENDIF}
|
||||||
|
H_Addr_List: ^pIn_Addr;
|
||||||
|
END;
|
||||||
|
|
||||||
|
pProtoEnt = ^tProtoEnt;
|
||||||
|
TProtoEnt = packed record
|
||||||
|
p_name: pChar; (* official protocol name *)
|
||||||
|
p_aliases: ^pChar; (* alias list *)
|
||||||
|
p_proto: SmallInt; (* protocol # *)
|
||||||
|
end;
|
||||||
|
|
||||||
|
pServEnt = ^tServEnt;
|
||||||
|
tServEnt = packed record
|
||||||
|
s_name: pChar; // official service name
|
||||||
|
s_aliases: ^pChar; // alias list
|
||||||
|
s_port: SmallInt; // port #
|
||||||
|
s_proto: pChar; // protocol to use
|
||||||
|
END;
|
||||||
|
|
||||||
|
// these types are only used in windows version
|
||||||
|
const
|
||||||
|
FD_SETSIZE = 64;
|
||||||
|
|
||||||
|
type
|
||||||
|
PFDSet = ^TFDSet;
|
||||||
|
TFDSet = packed record
|
||||||
|
fd_count: ULONG;
|
||||||
|
fd_array: array[0..FD_SETSIZE-1] of ULONG;
|
||||||
|
end;
|
||||||
|
|
||||||
|
PTimeVal = ^TTimeVal;
|
||||||
|
TTimeVal = packed record
|
||||||
|
tv_sec: Longint;
|
||||||
|
tv_usec: Longint;
|
||||||
|
end;
|
||||||
|
|
||||||
|
const
|
||||||
|
WSADESCRIPTION_LEN = 256;
|
||||||
|
WSASYS_STATUS_LEN = 128;
|
||||||
|
|
||||||
|
type
|
||||||
|
PWSAData = ^TWSAData;
|
||||||
|
TWSAData = packed record
|
||||||
|
wVersion: Word;
|
||||||
|
wHighVersion: Word;
|
||||||
|
szDescription: array[0..WSADESCRIPTION_LEN] of Char;
|
||||||
|
szSystemStatus: array[0..WSASYS_STATUS_LEN] of Char;
|
||||||
|
iMaxSockets: Word;
|
||||||
|
iMaxUdpDg: Word;
|
||||||
|
lpVendorInfo: PChar;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** The re-defination of error constants are necessary to avoid conflict with
|
||||||
|
** standard IBM C Set/2 V1.0 error constants.
|
||||||
|
**
|
||||||
|
** All OS/2 SOCKET API error constants are biased by SOCBASEERR from the "normal"
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
const
|
||||||
|
SOCBASEERR = 10000;
|
||||||
|
|
||||||
|
(*
|
||||||
|
** OS/2 SOCKET API definitions of regular Microsoft C 6.0 error constants
|
||||||
|
*)
|
||||||
|
|
||||||
|
const
|
||||||
|
SOCEPERM = (SOCBASEERR+1); (* Not owner *)
|
||||||
|
SOCESRCH = (SOCBASEERR+3); (* No such process *)
|
||||||
|
SOCEINTR = (SOCBASEERR+4); (* Interrupted system call *)
|
||||||
|
SOCENXIO = (SOCBASEERR+6); (* No such device or address *)
|
||||||
|
SOCEBADF = (SOCBASEERR+9); (* Bad file number *)
|
||||||
|
SOCEACCES = (SOCBASEERR+13); (* Permission denied *)
|
||||||
|
SOCEFAULT = (SOCBASEERR+14); (* Bad address *)
|
||||||
|
SOCEINVAL = (SOCBASEERR+22); (* Invalid argument *)
|
||||||
|
SOCEMFILE = (SOCBASEERR+24); (* Too many open files *)
|
||||||
|
SOCEPIPE = (SOCBASEERR+32); (* Broken pipe *)
|
||||||
|
|
||||||
|
SOCEOS2ERR = (SOCBASEERR+100); (* OS/2 Error *)
|
||||||
|
|
||||||
|
(*
|
||||||
|
** OS/2 SOCKET API definitions of regular BSD error constants
|
||||||
|
*)
|
||||||
|
|
||||||
|
const
|
||||||
|
SOCEWOULDBLOCK = (SOCBASEERR+35); (* Operation would block *)
|
||||||
|
SOCEINPROGRESS = (SOCBASEERR+36); (* Operation now in progress *)
|
||||||
|
SOCEALREADY = (SOCBASEERR+37); (* Operation already in progress *)
|
||||||
|
SOCENOTSOCK = (SOCBASEERR+38); (* Socket operation on non-socket *)
|
||||||
|
SOCEDESTADDRREQ = (SOCBASEERR+39); (* Destination address required *)
|
||||||
|
SOCEMSGSIZE = (SOCBASEERR+40); (* Message too long *)
|
||||||
|
SOCEPROTOTYPE = (SOCBASEERR+41); (* Protocol wrong type for socket *)
|
||||||
|
SOCENOPROTOOPT = (SOCBASEERR+42); (* Protocol not available *)
|
||||||
|
SOCEPROTONOSUPPORT = (SOCBASEERR+43); (* Protocol not supported *)
|
||||||
|
SOCESOCKTNOSUPPORT = (SOCBASEERR+44); (* Socket type not supported *)
|
||||||
|
SOCEOPNOTSUPP = (SOCBASEERR+45); (* Operation not supported on socket *)
|
||||||
|
SOCEPFNOSUPPORT = (SOCBASEERR+46); (* Protocol family not supported *)
|
||||||
|
SOCEAFNOSUPPORT = (SOCBASEERR+47); (* Address family not supported by protocol family *)
|
||||||
|
SOCEADDRINUSE = (SOCBASEERR+48); (* Address already in use *)
|
||||||
|
SOCEADDRNOTAVAIL = (SOCBASEERR+49); (* Can't assign requested address *)
|
||||||
|
SOCENETDOWN = (SOCBASEERR+50); (* Network is down *)
|
||||||
|
SOCENETUNREACH = (SOCBASEERR+51); (* Network is unreachable *)
|
||||||
|
SOCENETRESET = (SOCBASEERR+52); (* Network dropped connection on reset *)
|
||||||
|
SOCECONNABORTED = (SOCBASEERR+53); (* Software caused connection abort *)
|
||||||
|
SOCECONNRESET = (SOCBASEERR+54); (* Connection reset by peer *)
|
||||||
|
SOCENOBUFS = (SOCBASEERR+55); (* No buffer space available *)
|
||||||
|
SOCEISCONN = (SOCBASEERR+56); (* Socket is already connected *)
|
||||||
|
SOCENOTCONN = (SOCBASEERR+57); (* Socket is not connected *)
|
||||||
|
SOCESHUTDOWN = (SOCBASEERR+58); (* Can't send after socket shutdown *)
|
||||||
|
SOCETOOMANYREFS = (SOCBASEERR+59); (* Too many references: can't splice *)
|
||||||
|
SOCETIMEDOUT = (SOCBASEERR+60); (* Connection timed out *)
|
||||||
|
SOCECONNREFUSED = (SOCBASEERR+61); (* Connection refused *)
|
||||||
|
SOCELOOP = (SOCBASEERR+62); (* Too many levels of symbolic links *)
|
||||||
|
SOCENAMETOOLONG = (SOCBASEERR+63); (* File name too long *)
|
||||||
|
SOCEHOSTDOWN = (SOCBASEERR+64); (* Host is down *)
|
||||||
|
SOCEHOSTUNREACH = (SOCBASEERR+65); (* No route to host *)
|
||||||
|
SOCENOTEMPTY = (SOCBASEERR+66); (* Directory not empty *)
|
||||||
|
|
||||||
|
(*
|
||||||
|
** OS/2 SOCKET API errors redefined as regular BSD error constants
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end. { unit SockDef }
|
|
@ -0,0 +1,831 @@
|
||||||
|
unit SockFunc;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** SOCKFUNC routines
|
||||||
|
**
|
||||||
|
** Copyright (c) 1998 by Thomas W. Mueller
|
||||||
|
** Linux additions (c)1999 by Maarten Bekers
|
||||||
|
**
|
||||||
|
** Created : 24-Oct-1998
|
||||||
|
** Last update : 24-Oct-1998
|
||||||
|
**
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-
|
||||||
|
** Copyright (c) 1982, 1985, 1986 Regents of the University of California.
|
||||||
|
** All rights reserved.
|
||||||
|
**
|
||||||
|
** Redistribution and use in source and binary forms are permitted
|
||||||
|
** provided that this notice is preserved and that due credit is given
|
||||||
|
** to the University of California at Berkeley. The name of the University
|
||||||
|
** may not be used to endorse or promote products derived from this
|
||||||
|
** software without specific prior written permission. This software
|
||||||
|
** is provided ``as is'' without express or implied warranty.
|
||||||
|
s**
|
||||||
|
** @(#)socket.h 7.2 (Berkeley) 12/30/87
|
||||||
|
-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses
|
||||||
|
{$IFDEF OS2}
|
||||||
|
OS2Def,
|
||||||
|
IBMSO32,
|
||||||
|
IBMTCP32,
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
windows,
|
||||||
|
W32Sock,
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
linux,
|
||||||
|
Linsock,
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Sysutils,
|
||||||
|
SockDef;
|
||||||
|
|
||||||
|
Const SockInitted : Boolean = false;
|
||||||
|
|
||||||
|
function SockErrorNo: Longint;
|
||||||
|
function SockGetErrStr(_ErrNo: integer): ShortString;
|
||||||
|
procedure SockRaiseError(const _prefix: String; _ErrNo: integer);
|
||||||
|
procedure SockRaiseLastError(const _prefix: String);
|
||||||
|
|
||||||
|
function SockAccept(_SockDesc: tSockDesc; _SockAddr: pSockAddr;
|
||||||
|
var _SockAddrLen: Longint): tSockDesc;
|
||||||
|
function SockBind(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
|
||||||
|
function SockCancel(_SockDesc: tSockDesc): Longint;
|
||||||
|
function SockConnect(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
|
||||||
|
function SockGetHostByName(Hostname: ShortString): phostent;
|
||||||
|
function SockShutdown(_SockDesc: tSockDesc; _how: ULong): Longint;
|
||||||
|
function SockGetSockAddr(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
|
||||||
|
function SockGetSockOpt(_SockDesc: tSockDesc; _Level, _OptName: Integer;
|
||||||
|
_OptVal: PChar; var _OptLen: Integer): Longint;
|
||||||
|
function SockSetSockOpt(_SockDesc: tSockDesc; _Level: uLong; _OptName: Ulong;
|
||||||
|
_OptVal: pChar; _OptLen: uLong ): Longint;
|
||||||
|
function SockSetBlockingIO(_SockDesc: tSockDesc; _BlockingIO: boolean): Longint;
|
||||||
|
function SockIoCtlSocket(_SockDesc: tSockDesc; Func: Longint): Longint;
|
||||||
|
function SockListen(_SockDesc: tSockDesc; _SockQueue: ULong): Longint;
|
||||||
|
function SockRecv(_SockDesc: tSockDesc; _SockBuffer: pointer;
|
||||||
|
_SockBufLen: ULong; _SockFlags: ULong): Longint;
|
||||||
|
function SockSend(_SockDesc: tSockDesc; _SockBuffer: pointer;
|
||||||
|
_SockBufLen: ULong; _SockFlags: ULong ): Longint;
|
||||||
|
function SockSocket(_SockFamily: word; _SockType: word;
|
||||||
|
_SockProtocol: word ): tSockDesc;
|
||||||
|
function SockClose(_SockDesc: tSockDesc): Longint;
|
||||||
|
function SockInit: Longint;
|
||||||
|
function SockClientAlive(_SockDesc: tSockDesc): Boolean;
|
||||||
|
|
||||||
|
function SockGetHostAddrByName(_HostName: ShortString): ULONG;
|
||||||
|
function SockGetHostNameByAddr(_HostAddr: pIn_Addr): ShortString;
|
||||||
|
function SockGetHostname: ShortString;
|
||||||
|
|
||||||
|
function SockGetServByName(_Name, _Proto: ShortString): pServEnt;
|
||||||
|
function SockGetServPortByName(_Name, _Proto: ShortString): Longint;
|
||||||
|
|
||||||
|
function SockHtonl(_Input: LongInt): longint;
|
||||||
|
function SockHtons(_Input: SmallWord): SmallWord;
|
||||||
|
|
||||||
|
function SockNtohl(_Input: LongInt): longint;
|
||||||
|
function SockNtohs(_Input: SmallWord): longint;
|
||||||
|
function SockDataAvail(_SockDesc: tSockDesc): Boolean;
|
||||||
|
function SockSelect(_SockDesc: tSockDesc): Longint;
|
||||||
|
function SockInetAddr(_s: ShortString):tIn_Addr;
|
||||||
|
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
{$IFNDEF FPC}
|
||||||
|
{$R SOCKFUNC.RES}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
Const
|
||||||
|
Version = '1.00';
|
||||||
|
UseString: ShortString = '@(#)socket interface unit for IBM TCP/IP and WinSock'#0;
|
||||||
|
CopyRight1: ShortString = '@(#)socket Version '+Version+' - 26.08.1998'#0;
|
||||||
|
CopyRight2: ShortString = '@(#}(C) Thomas Mueller 1998'#0;
|
||||||
|
CopyRight3: ShortString = '@(#)(C) Chr.Hohmann BfS ST2.2 1996'#0;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
|
||||||
|
function SockErrorNo: Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_sock_errno;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := WsaGetLastError;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := SocketError;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockErrorNo }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetErrStr(_ErrNo: integer): ShortString;
|
||||||
|
begin
|
||||||
|
Result:=LoadStr(_ErrNo);
|
||||||
|
end; { func. SockGetErrStr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure SockRaiseError(const _prefix: String; _ErrNo: integer);
|
||||||
|
begin
|
||||||
|
raise eSocketErr.CreateFmt('%s: %s (%d)',
|
||||||
|
[_prefix, SockGetErrStr(_ErrNo), _ErrNo]);
|
||||||
|
end; { proc. SockRaiseError }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure SockRaiseLastError(const _prefix: String);
|
||||||
|
begin
|
||||||
|
SockRaiseError(_Prefix, SockErrorNo);
|
||||||
|
end; { proc. SockRaiseLastError }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
|
||||||
|
function SockGetServByName(_Name, _Proto: ShortString): pServEnt;
|
||||||
|
begin
|
||||||
|
_Name := _Name + #00;
|
||||||
|
_Proto := _Proto + #00;
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := getservbyname(@_Name[01], @_Proto[01]);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := ibm_getservbyname(@_Name[01], @_Proto[01]);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := getservbyname(@_Name[1], @_Proto[01]);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockGetServByName }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetServPortByName(_Name, _Proto: ShortString): longint;
|
||||||
|
var ServEnt: pServEnt;
|
||||||
|
begin
|
||||||
|
ServEnt := SockGetServByName(_Name, _Proto);
|
||||||
|
|
||||||
|
if Assigned(ServEnt) then
|
||||||
|
Result := ServEnt^.s_Port
|
||||||
|
else Result := -01;
|
||||||
|
end; { func. SockGetServPortByName }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockHtonl( _Input: longint): longint;
|
||||||
|
type SwapLong = packed record
|
||||||
|
case integer of
|
||||||
|
0: (SLong: longint);
|
||||||
|
1: (SArray: packed array[1..4] of byte);
|
||||||
|
end;
|
||||||
|
var Inp,
|
||||||
|
Tmp: SwapLong;
|
||||||
|
begin
|
||||||
|
Inp.SLong := _Input;
|
||||||
|
Tmp.SArray[1] := Inp.SArray[4];
|
||||||
|
Tmp.SArray[2] := Inp.SArray[3];
|
||||||
|
Tmp.SArray[3] := Inp.SArray[2];
|
||||||
|
Tmp.SArray[4] := Inp.SArray[1];
|
||||||
|
result := Tmp.SLong;
|
||||||
|
end;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockHtons( _Input: SmallWord): SmallWord;
|
||||||
|
type SwapWord = packed record
|
||||||
|
case integer of
|
||||||
|
0: (SWord: SmallWord);
|
||||||
|
1: (SArray: packed array[1..2] of byte);
|
||||||
|
end;
|
||||||
|
var Inp,Tmp: SwapWord;
|
||||||
|
begin
|
||||||
|
Inp.SWord := _Input;
|
||||||
|
Tmp.SArray[1] := Inp.SArray[2];
|
||||||
|
Tmp.SArray[2] := Inp.SArray[1];
|
||||||
|
Result := Tmp.SWord;
|
||||||
|
end; { func. SockhToNl }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockNtohl( _Input: longint): longint;
|
||||||
|
begin
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
Result:=ntohl(_Input);
|
||||||
|
{$ELSE}
|
||||||
|
{!!!!!!!!!!!!!!!!!!!!!!!}
|
||||||
|
Result := _Input;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. sockNToHl }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockNtohs( _Input: SmallWord): longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := ntohs( _input);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
{!!!!! Result := ntohs( _input);}
|
||||||
|
Result := Lo(_Input) * 256 + Hi(_Input);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := ntohs(_input);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockNToHs }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockAccept(_SockDesc: tSockDesc;
|
||||||
|
_SockAddr: pSockAddr;
|
||||||
|
var _SockAddrLen: Longint): longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := Accept(_SockDesc, _SockAddr, @_SockAddrLen);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_Accept(_SockDesc, _SockAddr, @_SockAddrLen);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := Accept(_SockDesc, _SockAddr^, _SockAddrLen);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockAccept }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockBind(_SockDesc: tSockDesc;
|
||||||
|
var _SockAddr: tSockAddr ): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockBind := Bind(_SockDesc, @_SockAddr, SockAddr_Len);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockBind := IBM_Bind(_SockDesc, @_SockAddr, SockAddr_Len);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockBind := Longint(Bind(_SockDesc, _SockAddr, SockAddr_Len));
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockBind }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockConnect(_SockDesc: tSockDesc;
|
||||||
|
var _SockAddr: tSockAddr): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockConnect := connect(_SockDesc, @_SockAddr, SockAddr_Len);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockConnect := ibm_connect(_SockDesc, @_SockAddr, SockAddr_Len);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockConnect := connect(_SockDesc, _SockAddr, sockAddr_Len);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockConnect }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockCancel(_SockDesc: tSockDesc): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := SockCancel(_SockDesc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_So_Cancel(_SockDesc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := longint(true);
|
||||||
|
if _SockDesc=0 then ;
|
||||||
|
|
||||||
|
{$WARNING SockCancel function not implemented }
|
||||||
|
{!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!}
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockCancel }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockShutdown(_SockDesc: tSockDesc;
|
||||||
|
_how: ULong): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockShutdown := ShutDown(_SockDesc, _How);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockShutDown := IBM_ShutDown(_SockDesc, _How);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockShutDown := ShutDown(_SockDesc, _How);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockShutDown }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetSockAddr(_SockDesc: tSockDesc; var _SockAddr: tSockAddr): Longint;
|
||||||
|
var sLength: Integer;
|
||||||
|
begin
|
||||||
|
FillChar(_SockAddr, SizeOf(_SockAddr), #00);
|
||||||
|
sLength := SizeOf(_SockAddr);
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := GetSockName(_SockDesc, @_SockAddr, sLength);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_GetSockName(_SockDesc, @_SockAddr, @sLength);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := GetSocketName(_SockDesc, _SockAddr, sLength);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. sockGetSockAddr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockSetBlockingIO(_SockDesc: tSockDesc;
|
||||||
|
_BlockingIO: boolean): Longint;
|
||||||
|
var Arg: ULONG;
|
||||||
|
begin
|
||||||
|
{$IFDEF OS2}
|
||||||
|
if _BlockingIO then Arg := 00
|
||||||
|
else Arg := 01;
|
||||||
|
|
||||||
|
Result := IBM_IOCtl(_SockDesc, FIONBIO, @Arg, SizeOf(Arg));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if _BlockingIO then Arg := 00
|
||||||
|
else Arg := 01;
|
||||||
|
|
||||||
|
Result := IOCtlSocket(_SockDesc, FIONBIO, Arg);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
if _BlockingIO then Arg := 00
|
||||||
|
else Arg := 01;
|
||||||
|
|
||||||
|
Result := Longint(ioctl(_SockDesc, Linux.FIONBIO, @Arg));
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockSetBlockingIO }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockIoCtlSocket(_SockDesc: tSockDesc; Func: Longint): Longint;
|
||||||
|
var Arg: ULONG;
|
||||||
|
begin
|
||||||
|
Arg := 0;
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_IOCtl(_SockDesc, FUNC, @Arg, SizeOf(Arg));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := IOCtlSocket(_SockDesc, FUNC, Arg);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := Longint(IoCtl(_SockDesc, Func, @Arg));
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockIoCtlSocket }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetSockOpt(_SockDesc: tSockDesc; _Level, _OptName: Integer;
|
||||||
|
_OptVal: PChar; var _OptLen: Integer): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := GetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_GetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := SetSocketOptions(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockGetSockOpt }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockSetSockOpt(_SockDesc: tSockDesc; _Level: uLong; _OptName: Ulong;
|
||||||
|
_OptVal: pChar; _OptLen: uLong ): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := SetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_SetSockOpt(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := SetSocketOptions(_SockDesc, _Level, _OptName, _OptVal, _OptLen);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockSetSockOpt }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockDataAvail(_SockDesc: tSockDesc): Boolean;
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
var ReadFDS : FDSet;
|
||||||
|
Temp : Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
Result := (SockSelect(_SockDesc) > 00);
|
||||||
|
{$ELSE}
|
||||||
|
fd_Zero(ReadFDS);
|
||||||
|
fd_Set(_SockDesc, ReadFDS);
|
||||||
|
|
||||||
|
Temp := Select(_SockDesc + 01, @ReadFDS, nil, nil, 0);
|
||||||
|
if (Temp > 0) then
|
||||||
|
begin
|
||||||
|
SockDataAvail := FD_ISSET(_SockDesc, ReadFDS);
|
||||||
|
end { if }
|
||||||
|
else SockDataAvail := false;
|
||||||
|
{$ENDIF}
|
||||||
|
(*
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Arg := 00;
|
||||||
|
Result := IBM_IOCTL(_SockDesc, FIONREAD, @Arg, SizeOf(Arg));
|
||||||
|
|
||||||
|
if Arg > 00 then Result := Arg
|
||||||
|
else Result := $FFFFFFFF;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := IOCtlSocket(_SockDesc, FIONREAD, Arg);
|
||||||
|
if Arg > 00 then Result := Arg
|
||||||
|
else Result := $FFFFFFFF;
|
||||||
|
{$ENDIF}
|
||||||
|
*)
|
||||||
|
end; { func. SockDataAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockListen(_SockDesc: tSockDesc;
|
||||||
|
_SockQueue: ULong): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockListen := listen(_SockDesc, _SockQueue);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockListen := ibm_listen(_SockDesc, _SockQueue);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockListen := Longint(Listen(_SockDesc, _SockQueue));
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockListen }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockSelect(_SockDesc: tSockDesc ): Longint;
|
||||||
|
{$IFDEF OS2}
|
||||||
|
var SockCopy: ULONG;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
var SockArr : TFDSet;
|
||||||
|
Timeout : TTimeVal;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
var ReadFDS : FDSet;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockCopy := _SockDesc;
|
||||||
|
Result := IBM_Select(@SockCopy, 1, 0, 0, 0);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockArr.fd_Count := 01;
|
||||||
|
SockArr.fd_Array[00] := _SockDesc;
|
||||||
|
Timeout.tv_sec := 00;
|
||||||
|
Timeout.tv_usec := 00;
|
||||||
|
|
||||||
|
Result := Select(00, @SockArr, NIL, NIL, @Timeout);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
fd_Zero(ReadFDS);
|
||||||
|
fd_Set(_SockDesc, ReadFDS);
|
||||||
|
|
||||||
|
SockSelect := Select(_SockDesc + 01, @ReadFDS, nil, nil, 0);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockSelect }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+ -*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockRecv(_SockDesc: tSockDesc;
|
||||||
|
_SockBuffer: pointer;
|
||||||
|
_SockBufLen: ULong;
|
||||||
|
_SockFlags: ULong): Longint;
|
||||||
|
var Counter: Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockRecv := recv(_SockDesc,
|
||||||
|
_SockBuffer,
|
||||||
|
_SockBufLen,
|
||||||
|
_SockFlags);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockRecv := ibm_recv(_SockDesc,
|
||||||
|
_SockBuffer,
|
||||||
|
_SockBufLen,
|
||||||
|
_SockFlags);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockRecv := Recv(_SockDesc,
|
||||||
|
_SockBuffer^,
|
||||||
|
_SockBufLen,
|
||||||
|
_SockFlags);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockRecv }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockSend(_SockDesc: tSockDesc;
|
||||||
|
_SockBuffer: pointer;
|
||||||
|
_SockBufLen: ULong;
|
||||||
|
_SockFlags: ULong): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockSend := Send(_SockDesc,
|
||||||
|
_SockBuffer,
|
||||||
|
_SockBufLen,
|
||||||
|
_SockFlags);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockSend := IBM_Send(_SockDesc,
|
||||||
|
_SockBuffer,
|
||||||
|
_SockBufLen,
|
||||||
|
_SockFlags);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockSend := Send(_SockDesc,
|
||||||
|
_SockBuffer^,
|
||||||
|
_SockBufLen,
|
||||||
|
_SockFlags);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockSocket(_SockFamily: word;
|
||||||
|
_SockType: word;
|
||||||
|
_SockProtocol: word): tSockDesc;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockSocket := Socket(_SockFamily, _SockType, _SockProtocol);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockSocket := ibm_Socket(_SockFamily, _SockType, _SockProtocol);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockSocket := Socket(_SockFamily, _SockType, _SockProtocol);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockSocket }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockClose(_SockDesc: tSockDesc): Longint;
|
||||||
|
begin
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_soclose(_SockDesc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := Closesocket(_SockDesc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := Longint(fdClose(_SockDesc));
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockClose }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockInit: Longint;
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
var Data: TWSAData;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
if SockInitted then EXIT;
|
||||||
|
SockInitted := true;
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockInit := IBM_Sock_Init;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockInit := WsaStartup($0101, Data);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
SockInit := 0;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockInit }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetHostByName(Hostname: ShortString): phostent;
|
||||||
|
begin
|
||||||
|
HostName := HostName + #00;
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Result := GetHostByName(@HostName[01]);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Result := IBM_GetHostByName(@HostName[01]);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := GetHostByName(@HostName[1]);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockGetHostByName }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetHostAddrByName(_HostName: ShortString): ULong;
|
||||||
|
var ReturnCode: pHostEnt;
|
||||||
|
InAddr : tIn_Addr;
|
||||||
|
begin
|
||||||
|
ReturnCode := SockGetHostbyName(_HostName);
|
||||||
|
if Assigned(ReturnCode) then
|
||||||
|
begin
|
||||||
|
InAddr := ReturnCode^.H_Addr_List^^;
|
||||||
|
Result := InAddr.IpAddr;
|
||||||
|
end
|
||||||
|
else Result:=$FFFFFFFF;
|
||||||
|
end; { func. SockGetHostAddrByName }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetHostByAddr(HostAddr: pIn_Addr;
|
||||||
|
HostAddrLen: ULong;
|
||||||
|
HostAddrType: ULong): pointer;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SockGetHostByAddr := GetHostbyAddr(HostAddr,
|
||||||
|
HostAddrLen,
|
||||||
|
HostAddrType);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SockGetHostByAddr := IBM_GetHostbyAddr(HostAddr,
|
||||||
|
HostAddrLen,
|
||||||
|
HostAddrType);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
Result := GetHostByAddr(HostAddr, HostAddrLen, HostAddrtype);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockGetHostbyAddr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetHostNameByAddr(_HostAddr: pIn_Addr): ShortString;
|
||||||
|
var Counter : Integer;
|
||||||
|
ReturnCode: pHostEnt;
|
||||||
|
HName : ShortString;
|
||||||
|
begin
|
||||||
|
ReturnCode := SockGetHostByAddr(_HostAddr,
|
||||||
|
In_Addr_Len,
|
||||||
|
AF_INET);
|
||||||
|
|
||||||
|
if (ULong(ReturnCode) <> 00) then
|
||||||
|
begin
|
||||||
|
HName := '';
|
||||||
|
Counter := 00;
|
||||||
|
|
||||||
|
While ReturnCode^.H_Name^[Counter] <> #00 do
|
||||||
|
begin
|
||||||
|
HName := HName + ReturnCode^.H_Name^[Counter];
|
||||||
|
Inc(Counter);
|
||||||
|
end; { while }
|
||||||
|
end
|
||||||
|
else HName := 'Hostname not found';
|
||||||
|
|
||||||
|
SockGetHostNameByAddr := HName;
|
||||||
|
end; { func. SockGetHostNameByAddr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockGetHostname: ShortString;
|
||||||
|
var Counter : Longint;
|
||||||
|
sResult : Longint;
|
||||||
|
HostName : ShortString;
|
||||||
|
InAddr : TIn_Addr;
|
||||||
|
begin
|
||||||
|
FillChar(HostName, SizeOf(HostName), #00);
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
sResult := GetHostName(@HostName[01], SizeOf(HostName));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
sResult := IBM_GetHostName(@HostName[01], SizeOf(HostName));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
{!!!!!!!!!!!!!!!!!!!}
|
||||||
|
InAddr.ClassA := 127;
|
||||||
|
InAddr.ClassB := 0;
|
||||||
|
InAddr.ClassC := 0;
|
||||||
|
InAddr.ClassD := 1;
|
||||||
|
|
||||||
|
HostName := SockGetHostNameByAddr(@InAddr) + #00;
|
||||||
|
sResult := Length(HostName);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
Counter := 01;
|
||||||
|
While (Counter < SizeOf(HostName)) AND (HostName[Counter] <> #00) do
|
||||||
|
Inc(Counter);
|
||||||
|
|
||||||
|
if (Counter > 01) then
|
||||||
|
SetLength(HostName, Counter)
|
||||||
|
else HostName := 'amnesiac';
|
||||||
|
|
||||||
|
SockGetHostname := HostName;
|
||||||
|
end; { func. SockGetHostName }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockInetAddr(_s: ShortString): tIn_Addr;
|
||||||
|
begin
|
||||||
|
_s := _s + #00;
|
||||||
|
|
||||||
|
{$IFNDEF LINUX}
|
||||||
|
Result.IpAddr := INet_Addr(@_S[01]);
|
||||||
|
{$ELSE}
|
||||||
|
{$WARNING SockInetAddr function not implemented! }
|
||||||
|
Result.IpAddr := INADDR_NONE;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. SockInetAddr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function SockClientAlive(_SockDesc: tSockDesc): Boolean;
|
||||||
|
var TempCH : Char;
|
||||||
|
Returncode : Longint;
|
||||||
|
TempError : Longint;
|
||||||
|
TempStr : String;
|
||||||
|
begin
|
||||||
|
Result := true;
|
||||||
|
|
||||||
|
ReturnCode := SockRecv(_SockDesc, @TempCH, SizeOf(TempCH), MSG_PEEK);
|
||||||
|
TempError := SockErrorNo;
|
||||||
|
|
||||||
|
TempStr := SockGetErrStr(TempError);
|
||||||
|
|
||||||
|
if ReturnCode = 0 then Result := false; { was: = 0 }
|
||||||
|
if (TempError <> WSAEWOULDBLOCK) AND (TempError <> 00) then
|
||||||
|
Result := false;
|
||||||
|
end; { func. SockClientAlive }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
initialization
|
||||||
|
{!! SockInit; }
|
||||||
|
|
||||||
|
finalization
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
//WsaCleanUp;
|
||||||
|
{$ENDIF}
|
||||||
|
end. { unit SockFunc }
|
|
@ -0,0 +1,92 @@
|
||||||
|
#define SOCEPERM 10001
|
||||||
|
#define SOCESRCH 10003
|
||||||
|
#define SOCEINTR 10004
|
||||||
|
#define SOCENXIO 10006
|
||||||
|
#define SOCEBADF 10009
|
||||||
|
#define SOCEACCES 10013
|
||||||
|
#define SOCEFAULT 10014
|
||||||
|
#define SOCEINVAL 10022
|
||||||
|
#define SOCEMFILE 10024
|
||||||
|
#define SOCEPIPE 10032
|
||||||
|
#define SOCEOS2ERR 10100
|
||||||
|
#define SOCEWOULDBLOCK 10035
|
||||||
|
#define SOCEINPROGRESS 10036
|
||||||
|
#define SOCEALREADY 10037
|
||||||
|
#define SOCENOTSOCK 10038
|
||||||
|
#define SOCEDESTADDRREQ 10039
|
||||||
|
#define SOCEMSGSIZE 10040
|
||||||
|
#define SOCEPROTOTYPE 10041
|
||||||
|
#define SOCENOPROTOOPT 10042
|
||||||
|
#define SOCEPROTONOSUPPORT 10043
|
||||||
|
#define SOCESOCKTNOSUPPORT 10044
|
||||||
|
#define SOCEOPNOTSUPP 10045
|
||||||
|
#define SOCEPFNOSUPPORT 10046
|
||||||
|
#define SOCEAFNOSUPPORT 10047
|
||||||
|
#define SOCEADDRINUSE 10048
|
||||||
|
#define SOCEADDRNOTAVAIL 10049
|
||||||
|
#define SOCENETDOWN 10050
|
||||||
|
#define SOCENETUNREACH 10051
|
||||||
|
#define SOCENETRESET 10052
|
||||||
|
#define SOCECONNABORTED 10053
|
||||||
|
#define SOCECONNRESET 10054
|
||||||
|
#define SOCENOBUFS 10055
|
||||||
|
#define SOCEISCONN 10056
|
||||||
|
#define SOCENOTCONN 10057
|
||||||
|
#define SOCESHUTDOWN 10058
|
||||||
|
#define SOCETOOMANYREFS 10059
|
||||||
|
#define SOCETIMEDOUT 10060
|
||||||
|
#define SOCECONNREFUSED 10061
|
||||||
|
#define SOCELOOP 10062
|
||||||
|
#define SOCENAMETOOLONG 10063
|
||||||
|
#define SOCEHOSTDOWN 10064
|
||||||
|
#define SOCEHOSTUNREACH 10065
|
||||||
|
#define SOCENOTEMPTY 10066
|
||||||
|
|
||||||
|
|
||||||
|
STRINGTABLE
|
||||||
|
{
|
||||||
|
SOCEPERM, "Not owner"
|
||||||
|
SOCESRCH, "No such process"
|
||||||
|
SOCEINTR, "Interrupted system call"
|
||||||
|
SOCENXIO, "No such device or address"
|
||||||
|
SOCEBADF, "Bad file number"
|
||||||
|
SOCEACCES, "Permission denied"
|
||||||
|
SOCEFAULT, "Bad address"
|
||||||
|
SOCEINVAL, "Invalid argument"
|
||||||
|
SOCEMFILE, "Too many open files"
|
||||||
|
SOCEPIPE, "Broken pipe"
|
||||||
|
SOCEOS2ERR, "OS/2 Error"
|
||||||
|
SOCEWOULDBLOCK, "Operation would block"
|
||||||
|
SOCEINPROGRESS, "Operation now in progress"
|
||||||
|
SOCEALREADY, "Operation already in progress"
|
||||||
|
SOCENOTSOCK, "Socket operation on non-socket"
|
||||||
|
SOCEDESTADDRREQ, "Destination address required"
|
||||||
|
SOCEMSGSIZE, "Message too long"
|
||||||
|
SOCEPROTOTYPE, "Protocol wrong type for socket"
|
||||||
|
SOCENOPROTOOPT, "Protocol not available"
|
||||||
|
SOCEPROTONOSUPPORT, "Protocol not supported"
|
||||||
|
SOCESOCKTNOSUPPORT, "Socket type not supported"
|
||||||
|
SOCEOPNOTSUPP, "Operation not supported on socket"
|
||||||
|
SOCEPFNOSUPPORT, "Protocol family not supported"
|
||||||
|
SOCEAFNOSUPPORT, "Address family not supported by protocol family"
|
||||||
|
SOCEADDRINUSE, "Address already in use"
|
||||||
|
SOCEADDRNOTAVAIL, "Can't assign requested address"
|
||||||
|
SOCENETDOWN, "Network is down"
|
||||||
|
SOCENETUNREACH, "Network is unreachable"
|
||||||
|
SOCENETRESET, "Network dropped connection on reset"
|
||||||
|
SOCECONNABORTED, "Software caused connection abort"
|
||||||
|
SOCECONNRESET, "Connection reset by peer"
|
||||||
|
SOCENOBUFS, "No buffer space available"
|
||||||
|
SOCEISCONN, "Socket is already connected"
|
||||||
|
SOCENOTCONN, "Socket is not connected"
|
||||||
|
SOCESHUTDOWN, "Can't send after socket shutdown"
|
||||||
|
SOCETOOMANYREFS, "Too many references: can't splice"
|
||||||
|
SOCETIMEDOUT, "Connection timed out"
|
||||||
|
SOCECONNREFUSED, "Connection refused"
|
||||||
|
SOCELOOP, "Too many levels of symbolic links"
|
||||||
|
SOCENAMETOOLONG, "File name too long"
|
||||||
|
SOCEHOSTDOWN, "Host is down"
|
||||||
|
SOCEHOSTUNREACH, "No route to host"
|
||||||
|
SOCENOTEMPTY, "Directory not empty"
|
||||||
|
}
|
||||||
|
|
Binary file not shown.
|
@ -0,0 +1,863 @@
|
||||||
|
unit TELNET;
|
||||||
|
{$h-}
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 21-May-1998
|
||||||
|
** Last update : 04-Apr-1999
|
||||||
|
**
|
||||||
|
** Note: (c) 1998-1999 by Maarten Bekers
|
||||||
|
**
|
||||||
|
** Note: Same story of what we said in Win32, only we have here 2 seperate
|
||||||
|
** threads. The Write-thread has no problems, the read-thread is run
|
||||||
|
** max every 5 seconds, or whenever a carrier-check is performed. This
|
||||||
|
** carrier check is run on most BBS programs each second. You can
|
||||||
|
** optimize this by making the ReadThread a blocking select() call on
|
||||||
|
** the fd_read socket, but this can have other issues. A better approach
|
||||||
|
** on Win32 would be to call the WsaAsyncSelect() call, but this is
|
||||||
|
** non portable.
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses SockFunc, SockDef, Combase, BufUnit, Threads
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
,Windows
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
,Os2Base
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF VirtualPascal}
|
||||||
|
,Use32
|
||||||
|
{$ENDIF};
|
||||||
|
|
||||||
|
Const WriteTimeout = 5000; { Wait max. 5 secs }
|
||||||
|
ReadTimeOut = 5000; { General event, 5 secs max }
|
||||||
|
|
||||||
|
InBufSize = 1024 * 32;
|
||||||
|
OutBufSize = 1024 * 32;
|
||||||
|
|
||||||
|
|
||||||
|
type TTelnetObj = Object(TCommObj)
|
||||||
|
ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
ThreadsInitted : Boolean;
|
||||||
|
NeedNewCarrier : Boolean;
|
||||||
|
TelnetCarrier : Boolean;
|
||||||
|
|
||||||
|
IacDontDo : Longint; { ugly hack to prevent missed IACs }
|
||||||
|
IacState : Longint; { 0 = nothing }
|
||||||
|
{ 1 = received IAC }
|
||||||
|
{ 2 = handing the IAC }
|
||||||
|
ClientRC : Longint;
|
||||||
|
|
||||||
|
InBuffer : ^BufArrayObj; { Buffer system internally used }
|
||||||
|
OutBuffer : ^BufArrayObj;
|
||||||
|
|
||||||
|
DoTxEvent : PSysEventObj; { Event manually set when we have to transmit }
|
||||||
|
DoRxEvent : PSysEventObj; { Event manually set when we need data }
|
||||||
|
|
||||||
|
TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed }
|
||||||
|
RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed }
|
||||||
|
|
||||||
|
CriticalTx : PExclusiveObj; { Critical sections }
|
||||||
|
CriticalRx : PExclusiveObj;
|
||||||
|
|
||||||
|
TxThread : PThreadsObj; { The Transmit and Receive threads }
|
||||||
|
RxThread : PThreadsObj;
|
||||||
|
|
||||||
|
EndThreads : Boolean; { Set to true when we have to end the threads }
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
||||||
|
function Com_GetChar: Char; virtual;
|
||||||
|
function Com_PeekChar: Char; virtual;
|
||||||
|
function Com_CharAvail: Boolean; virtual;
|
||||||
|
function Com_Carrier: Boolean; virtual;
|
||||||
|
function Com_SendChar(C: Char): Boolean; virtual;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
||||||
|
function Com_GetBPSrate: Longint; virtual;
|
||||||
|
function Com_GetHandle: Longint; virtual;
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
||||||
|
procedure Com_Close; virtual;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_PeekBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
||||||
|
procedure Com_SetDtr(State: Boolean); virtual;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
||||||
|
procedure Com_PurgeInBuffer; virtual;
|
||||||
|
procedure Com_PurgeOutBuffer; virtual;
|
||||||
|
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
||||||
|
|
||||||
|
procedure Com_ReadProc(var TempPtr: Pointer);
|
||||||
|
procedure Com_WriteProc(var TempPtr: Pointer);
|
||||||
|
|
||||||
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
||||||
|
|
||||||
|
function Com_StartThread: Boolean;
|
||||||
|
procedure Com_InitVars;
|
||||||
|
procedure Com_StopThread;
|
||||||
|
|
||||||
|
function Com_SendWill(Option: Char): String;
|
||||||
|
function Com_SendWont(Option: Char): String;
|
||||||
|
function Com_SendDo(Option: Char): String;
|
||||||
|
procedure Com_SendRawStr(TempStr: String);
|
||||||
|
procedure Com_PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint);
|
||||||
|
procedure Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint);
|
||||||
|
end; { object TTelnetObj }
|
||||||
|
|
||||||
|
Type PTelnetObj = ^TTelnetObj;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses SysUtils;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$I WINDEF.FPC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
|
||||||
|
Const
|
||||||
|
{ Telnet Options }
|
||||||
|
TELNET_IAC = #255; { Interpret as Command }
|
||||||
|
TELNET_DONT = #254; { Stop performing, or not expecting him to perform }
|
||||||
|
TELNET_DO = #253; { Perform, or expect him to perform }
|
||||||
|
TELNET_WONT = #252; { Refusal to perform }
|
||||||
|
TELNET_WILL = #251; { Desire to perform }
|
||||||
|
|
||||||
|
TELNET_SB = #250; { What follow is sub-negotiation of indicated option }
|
||||||
|
TELNET_GA = #249; { Go ahead signal }
|
||||||
|
TELNET_EL = #248; { Erase Line function }
|
||||||
|
TELNET_EC = #247; { Erase Character function }
|
||||||
|
TELNET_AYT = #246; { Are You There function }
|
||||||
|
TELNET_AO = #245; { Abort Output function }
|
||||||
|
TELNET_IP = #244; { Interrupt Process function }
|
||||||
|
TELNET_BRK = #243; { NVT break character }
|
||||||
|
TELNET_DM = #242; { Data stream portion of a Synch }
|
||||||
|
TELNET_NOP = #241; { No operation }
|
||||||
|
TELNET_SE = #240; { End of sub-negotiation parameters }
|
||||||
|
TELNET_EOR = #239; { End of record }
|
||||||
|
TELNET_ABORT = #238; { Abort process }
|
||||||
|
TELNET_SUSP = #237; { Suspend current process }
|
||||||
|
TELNET_EOF = #236; { End of file }
|
||||||
|
|
||||||
|
TELNETOPT_BINARY = #0; { Transmit binary }
|
||||||
|
TELNETOPT_ECHO = #1; { Echo mode }
|
||||||
|
TELNETOPT_SUPGA = #3; { Suppress Go-Ahead }
|
||||||
|
TELNETOPT_TERM = #24; { Terminal Type }
|
||||||
|
TELNETOPT_SPEED = #32; { Terminal Speed }
|
||||||
|
TELNETOPT_FLOWCNT= #33; { Toggle flow-control }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TTelnetObj.Init;
|
||||||
|
begin
|
||||||
|
inherited Init;
|
||||||
|
|
||||||
|
ThreadsInitted := false;
|
||||||
|
NeedNewCarrier := true;
|
||||||
|
TelnetCarrier := TRUE;
|
||||||
|
IacState := 0; { default to none }
|
||||||
|
Com_InitVars;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TTelnetObj.Done;
|
||||||
|
begin
|
||||||
|
inherited done;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_SendRawStr(TempStr: String);
|
||||||
|
var BytesSnt: Longint;
|
||||||
|
TmpByte : Longint;
|
||||||
|
BufFlag : Longint;
|
||||||
|
TmpError: Longint;
|
||||||
|
begin
|
||||||
|
BufFlag := 00;
|
||||||
|
TmpByte := 01;
|
||||||
|
|
||||||
|
REPEAT
|
||||||
|
BytesSnt := SockSend(ClientRC,
|
||||||
|
@TempStr[TmpByte],
|
||||||
|
Length(TempStr),
|
||||||
|
BufFlag);
|
||||||
|
|
||||||
|
if BytesSnt > 0 then
|
||||||
|
Inc(TmpByte, BytesSnt)
|
||||||
|
else begin
|
||||||
|
TmpError := SockErrorNo;
|
||||||
|
if TmpError <> WSAEWOULDBLOCK then EXIT;
|
||||||
|
end; { else }
|
||||||
|
|
||||||
|
UNTIL (TmpByte > Length(TempStr));
|
||||||
|
end; { proc. Com_SendRawStr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_SendWill(Option: Char): String;
|
||||||
|
begin
|
||||||
|
Result[1] := TELNET_IAC;
|
||||||
|
Result[2] := TELNET_WILL;
|
||||||
|
Result[3] := Option;
|
||||||
|
SetLength(Result, 3);
|
||||||
|
end; { func. Com_SendWill }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_SendWont(Option: Char): String;
|
||||||
|
begin
|
||||||
|
Result[1] := TELNET_IAC;
|
||||||
|
Result[2] := TELNET_WONT;
|
||||||
|
Result[3] := Option;
|
||||||
|
SetLength(Result, 3);
|
||||||
|
end; { func. Com_SendWont }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_SendDo(Option: Char): String;
|
||||||
|
begin
|
||||||
|
Result[1] := TELNET_IAC;
|
||||||
|
Result[2] := TELNET_DO;
|
||||||
|
Result[3] := Option;
|
||||||
|
SetLength(Result, 3);
|
||||||
|
end; { func. Com_SendDo }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_PrepareBufferRead(var CurBuffer: CharBufType; var TempOut: BufArrayObj; BlockLen: Longint);
|
||||||
|
var Counter : Longint;
|
||||||
|
begin
|
||||||
|
Counter := 00;
|
||||||
|
if BlockLen = 0 then EXIT;
|
||||||
|
|
||||||
|
While Counter <= (Blocklen - 01) do
|
||||||
|
begin
|
||||||
|
{-- and now handle the IAC state ---------------------------------------}
|
||||||
|
Case IacState of
|
||||||
|
1 : begin { DO / DONT }
|
||||||
|
{-- we received an IAC, and this is the next char --------------}
|
||||||
|
if CurBuffer[Counter] = TELNET_IAC then
|
||||||
|
begin
|
||||||
|
TempOut.Put(CurBuffer[Counter], 1);
|
||||||
|
IacState := 0; { reset parser state }
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
IacState := 2;
|
||||||
|
|
||||||
|
Case CurBuffer[Counter] of
|
||||||
|
TELNET_DONT,
|
||||||
|
TELNET_DO : IacDontDo := 1;
|
||||||
|
else IacDontDo := 0;
|
||||||
|
end; { case }
|
||||||
|
end; { else }
|
||||||
|
end; { DO/DONT }
|
||||||
|
2 : begin { WHAT }
|
||||||
|
{ if IacDontDo = 1 then }
|
||||||
|
begin
|
||||||
|
Case CurBuffer[Counter] of
|
||||||
|
TELNETOPT_BINARY,
|
||||||
|
TELNETOPT_SUPGA,
|
||||||
|
TELNETOPT_ECHO : begin
|
||||||
|
Com_SendRawStr(Com_SendWill(CurBuffer[Counter]));
|
||||||
|
end
|
||||||
|
else begin
|
||||||
|
Com_SendRawStr(Com_SendWont(CurBuffer[Counter]));
|
||||||
|
end; { if }
|
||||||
|
end; { case }
|
||||||
|
end; { if this is a state we will reply to }
|
||||||
|
|
||||||
|
IacState := 0; { reset IAC state machine }
|
||||||
|
end; { WHAT }
|
||||||
|
else begin
|
||||||
|
if CurBuffer[Counter] = TELNET_IAC then
|
||||||
|
begin
|
||||||
|
IacState := 1
|
||||||
|
end
|
||||||
|
else TempOut.Put(CurBuffer[Counter], 1);
|
||||||
|
end; { else }
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
{-- and loop through the buffer ----------------------------------------}
|
||||||
|
Inc(Counter);
|
||||||
|
end; { while }
|
||||||
|
|
||||||
|
end; { proc. Com_PrepareBufferRead }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_PrepareBufferWrite(var CurBuffer, TmpOutBuffer: CharBufType; var BlockLen: Longint);
|
||||||
|
var Counter : Longint;
|
||||||
|
NewCounter: Longint;
|
||||||
|
begin
|
||||||
|
Counter := 00;
|
||||||
|
NewCounter := 00;
|
||||||
|
if BlockLen = 0 then EXIT;
|
||||||
|
|
||||||
|
While Counter <= Blocklen do
|
||||||
|
begin
|
||||||
|
Case CurBuffer[Counter] of
|
||||||
|
TELNET_IAC : begin { Escape command character }
|
||||||
|
TmpOutBuffer[NewCounter] := TELNET_IAC;
|
||||||
|
Inc(NewCounter);
|
||||||
|
TmpOutBuffer[NewCounter] := TELNET_IAC;
|
||||||
|
Inc(NewCounter);
|
||||||
|
end; { if }
|
||||||
|
else begin
|
||||||
|
TmpOutBuffer[NewCounter] := CurBuffer[Counter];
|
||||||
|
Inc(NewCounter);
|
||||||
|
end; { if }
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
Inc(Counter);
|
||||||
|
end; { while }
|
||||||
|
|
||||||
|
BlockLen := NewCounter - 1;
|
||||||
|
end; { proc. Com_PrepareBufferWrite }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_ReadProc(var TempPtr: Pointer);
|
||||||
|
var Available : Boolean;
|
||||||
|
BytesRead : Longint;
|
||||||
|
BlockLen : Longint;
|
||||||
|
ReturnCode: Longint;
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
if DoRxEvent^.WaitForEvent(ReadTimeOut) then
|
||||||
|
if NOT EndThreads then
|
||||||
|
begin
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
Available := (SockSelect(ClientRC) > 00);
|
||||||
|
|
||||||
|
DoRxEvent^.ResetEvent;
|
||||||
|
|
||||||
|
if (Available) OR (NeedNewCarrier) then
|
||||||
|
begin
|
||||||
|
{----------- Start reading the gathered date -------------------}
|
||||||
|
NeedNewCarrier := false;
|
||||||
|
|
||||||
|
if InBuffer^.BufRoom > 0 then
|
||||||
|
begin
|
||||||
|
BlockLen := InBuffer^.BufRoom;
|
||||||
|
if BlockLen > 1024 then
|
||||||
|
BlockLen := 1024;
|
||||||
|
|
||||||
|
if BlockLen > 00 then
|
||||||
|
begin
|
||||||
|
BytesRead := SockRecv(ClientRC,
|
||||||
|
@InBuffer^.TmpBuf,
|
||||||
|
BlockLen,
|
||||||
|
0);
|
||||||
|
|
||||||
|
if BytesRead = 0 then
|
||||||
|
begin
|
||||||
|
TelnetCarrier := false;
|
||||||
|
|
||||||
|
ReturnCode := SockErrorNo;
|
||||||
|
|
||||||
|
ErrorStr := 'Error in communications(1), #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
if BytesRead = -1 then
|
||||||
|
begin
|
||||||
|
ReturnCode := SockErrorNo;
|
||||||
|
|
||||||
|
if ReturnCode <> WSAEWOULDBLOCK then
|
||||||
|
begin
|
||||||
|
TelnetCarrier := false;
|
||||||
|
|
||||||
|
ErrorStr := 'Error in communications(2), #'+IntToStr(ReturnCode)+ ' / '+SysErrorMessage(ReturnCode);
|
||||||
|
EndThreads := true;
|
||||||
|
end; { if }
|
||||||
|
end; { error }
|
||||||
|
|
||||||
|
if BytesRead > 00 then
|
||||||
|
begin
|
||||||
|
Com_PrepareBufferRead(InBuffer^.TmpBuf, InBuffer^, BytesRead);
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end; { if available }
|
||||||
|
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { if RxEvent }
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
RxClosedEvent^.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. Com_ReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_WriteProc(var TempPtr: Pointer);
|
||||||
|
var BlockLen : Longint;
|
||||||
|
Written : Longint;
|
||||||
|
ReturnCode : Longint;
|
||||||
|
TempBuf : ^CharBufType;
|
||||||
|
begin
|
||||||
|
New(TempBuf);
|
||||||
|
|
||||||
|
repeat
|
||||||
|
if DoTxEvent^.WaitForEvent(WriteTimeOut) then
|
||||||
|
if NOT EndThreads then
|
||||||
|
begin
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
DoTxEvent^.ResetEvent;
|
||||||
|
|
||||||
|
if OutBuffer^.BufUsed > 00 then
|
||||||
|
begin
|
||||||
|
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false);
|
||||||
|
|
||||||
|
Com_PrepareBufferWrite(OutBuffer^.TmpBuf, TempBuf^, BlockLen);
|
||||||
|
Written := SockSend(ClientRC,
|
||||||
|
TempBuf,
|
||||||
|
BlockLen,
|
||||||
|
0);
|
||||||
|
{-- remove the data from the buffer, but only remove the data ---}
|
||||||
|
{-- thats actually written --------------------------------------}
|
||||||
|
ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true);
|
||||||
|
|
||||||
|
if ReturnCode <> Longint(Written) then
|
||||||
|
begin
|
||||||
|
{ not everything is removed! }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
{-- if theres data in the buffer left, run this event again -----}
|
||||||
|
if Written <> BlockLen then
|
||||||
|
begin
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
Dispose(TempBuf);
|
||||||
|
|
||||||
|
TxClosedEvent^.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. Com_WriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_StartThread: Boolean;
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
EndThreads := false;
|
||||||
|
if ThreadsInitted then EXIT;
|
||||||
|
ThreadsInitted := true;
|
||||||
|
|
||||||
|
{----------------------- Create all the events ----------------------------}
|
||||||
|
New(DoTxEvent, Init);
|
||||||
|
if NOT DoTxEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(DoRxEvent, Init);
|
||||||
|
if NOT DoRxEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(RxClosedEvent, Init);
|
||||||
|
if NOT RxClosedEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(TxClosedEvent, Init);
|
||||||
|
if NOT TxClosedEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
{-------------- Startup the buffers and overlapped events -----------------}
|
||||||
|
New(InBuffer, Init(InBufSize));
|
||||||
|
New(OutBuffer, Init(OutBufSize));
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate write thread ---------------------}
|
||||||
|
New(CriticalTx, Init);
|
||||||
|
CriticalTx^.CreateExclusive;
|
||||||
|
|
||||||
|
New(TxThread, Init);
|
||||||
|
if NOT TxThread^.CreateThread(16384, { Stack size }
|
||||||
|
WriteProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate read thread ----------------------}
|
||||||
|
New(CriticalRx, Init);
|
||||||
|
CriticalRx^.CreateExclusive;
|
||||||
|
|
||||||
|
New(RxThread, Init);
|
||||||
|
if NOT RxThread^.CreateThread(16384, { Stack size }
|
||||||
|
ReadProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
Result := true;
|
||||||
|
end; { proc. Com_StartThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_InitVars;
|
||||||
|
begin
|
||||||
|
DoTxEvent := nil;
|
||||||
|
DoRxEvent := nil;
|
||||||
|
RxClosedEvent := nil;
|
||||||
|
TxClosedEvent := nil;
|
||||||
|
TxThread := nil;
|
||||||
|
RxThread := nil;
|
||||||
|
|
||||||
|
InBuffer := nil;
|
||||||
|
OutBuffer := nil;
|
||||||
|
CriticalRx := nil;
|
||||||
|
CriticalTx := nil;
|
||||||
|
end; { proc. Com_InitVars }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_StopThread;
|
||||||
|
begin
|
||||||
|
EndThreads := true;
|
||||||
|
ThreadsInitted := false;
|
||||||
|
|
||||||
|
if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
|
||||||
|
if DoTxEvent <> nil then DoRxEvent^.SignalEvent;
|
||||||
|
|
||||||
|
if TxThread <> nil then TxThread^.CloseThread;
|
||||||
|
if RxThread <> nil then RxThread^.CloseThread;
|
||||||
|
|
||||||
|
if TxClosedEvent <> nil then
|
||||||
|
if NOT TxClosedEvent^.WaitForEvent(1000) then
|
||||||
|
TxThread^.TerminateThread(0);
|
||||||
|
|
||||||
|
if RxClosedEvent <> nil then
|
||||||
|
if NOT RxClosedEvent^.WaitForEvent(1000) then
|
||||||
|
RxThread^.TerminateThread(0);
|
||||||
|
|
||||||
|
if TxThread <> nil then Dispose(TxThread, Done);
|
||||||
|
if RxThread <> nil then Dispose(RxThread, Done);
|
||||||
|
|
||||||
|
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
|
||||||
|
if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
|
||||||
|
if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
|
||||||
|
if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done);
|
||||||
|
|
||||||
|
if CriticalTx <> nil then Dispose(CriticalTx, Done);
|
||||||
|
if CriticalRx <> nil then Dispose(CriticalRx, Done);
|
||||||
|
|
||||||
|
if InBuffer <> nil then Dispose(InBuffer, Done);
|
||||||
|
if OutBuffer <> nil then Dispose(OutBuffer, Done);
|
||||||
|
|
||||||
|
Com_InitVars;
|
||||||
|
end; { proc. Com_StopThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_GetHandle: Longint;
|
||||||
|
begin
|
||||||
|
Result := ClientRC;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_OpenQuick(Handle: Longint);
|
||||||
|
var ReturnCode: Longint;
|
||||||
|
begin
|
||||||
|
ClientRC := Handle;
|
||||||
|
|
||||||
|
if (NOT (SockInit=0)) then
|
||||||
|
begin
|
||||||
|
ReturnCode := SockErrorNo;
|
||||||
|
|
||||||
|
ErrorStr := 'Error in initializing socket, #'+IntToStr(Returncode)+ ' / '+SysErrorMessage(Returncode);
|
||||||
|
InitFailed := true;
|
||||||
|
end
|
||||||
|
else InitFailed := NOT Com_StartThread;
|
||||||
|
|
||||||
|
{ Set the telnet to binary transmission }
|
||||||
|
Com_SendRawStr(Com_SendWill(TELNETOPT_ECHO));
|
||||||
|
Com_SendRawStr(Com_SendWill(TELNETOPT_BINARY));
|
||||||
|
end; { proc. TTelnetObj.Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
Com_OpenKeep := InitFailed;
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_Open := true;
|
||||||
|
end; { func. TTelnetObj.Com_OpenCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
begin
|
||||||
|
// Duhhh ;)
|
||||||
|
end; { proc. TTelnetObj.Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_Close;
|
||||||
|
begin
|
||||||
|
if DontClose then EXIT;
|
||||||
|
|
||||||
|
if ClientRC <> -1 then
|
||||||
|
begin
|
||||||
|
Com_StopThread;
|
||||||
|
SockShutdown(ClientRC, 02);
|
||||||
|
SockClose(ClientRC);
|
||||||
|
|
||||||
|
ClientRC := -1;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
end; { func. TTelnetObj.Com_CloseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_SendChar(C: Char): Boolean;
|
||||||
|
var Written: Longint;
|
||||||
|
begin
|
||||||
|
Com_SendBlock(C, SizeOf(C), Written);
|
||||||
|
Com_SendChar := (Written = SizeOf(c));
|
||||||
|
end; { proc. TTelnetObj.Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_GetChar: Char;
|
||||||
|
var Reads: Longint;
|
||||||
|
begin
|
||||||
|
Com_ReadBlock(Result, SizeOf(Result), Reads);
|
||||||
|
end; { func. TTelnetObj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_PeekChar: Char;
|
||||||
|
var Reads: Longint;
|
||||||
|
begin
|
||||||
|
Com_PeekBlock(Result, SizeOf(Result), Reads);
|
||||||
|
end; { func. TTelnetObj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
begin
|
||||||
|
if OutBuffer^.BufRoom < BlockLen then
|
||||||
|
repeat
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosSleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
Written := OutBuffer^.Put(Block, BlockLen);
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
end; { proc. TTelnetObj.Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < BlockLen then
|
||||||
|
begin
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
|
||||||
|
repeat
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosSleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
if Com_CharAvail then
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Reads := InBuffer^.Get(Block, BlockLen, true);
|
||||||
|
end; { proc. TTelnetObj.Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_PeekBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < BlockLen then
|
||||||
|
begin
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
|
||||||
|
repeat
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosSleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
if Com_CharAvail then
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Reads := InBuffer^.Get(Block, BlockLen, false);
|
||||||
|
end; { proc. TTelnetObj.Com_PeekBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_CharAvail: Boolean;
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < 1 then
|
||||||
|
begin
|
||||||
|
if (SockSelect(ClientRC) > 0) then
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Result := (InBuffer^.BufUsed > 0);
|
||||||
|
end; { func. TTelnetObj.Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_Carrier: Boolean;
|
||||||
|
begin
|
||||||
|
if TelnetCarrier then { Carrier is only lost in 'read' sections }
|
||||||
|
begin
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
NeedNewCarrier := true;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Result := TelnetCarrier;
|
||||||
|
end; { func. TTelnetObj.Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
begin
|
||||||
|
LineStatus := 00;
|
||||||
|
ModemStatus := 08;
|
||||||
|
|
||||||
|
if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7);
|
||||||
|
end; { proc. TTelnetObj.Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_SetDtr(State: Boolean);
|
||||||
|
begin
|
||||||
|
if NOT State then
|
||||||
|
begin
|
||||||
|
Com_Close;
|
||||||
|
end; { if }
|
||||||
|
end; { proc. TTelnetObj.Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_GetBpsRate: Longint;
|
||||||
|
begin
|
||||||
|
Com_GetBpsRate := 115200;
|
||||||
|
end; { func. TTelnetObj.Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
begin
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
|
||||||
|
InFree := InBuffer^.BufRoom;
|
||||||
|
OutFree := OutBuffer^.BufRoom;
|
||||||
|
InUsed := InBuffer^.BufUsed;
|
||||||
|
OutUsed := OutBuffer^.BufUsed;
|
||||||
|
end; { proc. TTelnetObj.Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
|
||||||
|
InBuffer^.Clear;
|
||||||
|
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { proc. TTelnetObj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
|
||||||
|
OutBuffer^.Clear;
|
||||||
|
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
end; { proc. TTelnetObj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TTelnetObj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Result := OutBuffer^.BufRoom >= BlockLen;
|
||||||
|
end; { func. ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_PauseCom(CloseCom: Boolean);
|
||||||
|
begin
|
||||||
|
if CloseCom then Com_Close
|
||||||
|
else Com_StopThread;
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
begin
|
||||||
|
if OpenCom then Com_OpenKeep(0)
|
||||||
|
else Com_StartThread;
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TTelnetObj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
||||||
|
begin
|
||||||
|
ReadProcPtr := ReadPtr;
|
||||||
|
WriteProcPtr := WritePtr;
|
||||||
|
end; { proc. Com_SetDataProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,421 @@
|
||||||
|
unit THREADS;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.12 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 07-Mar-1999
|
||||||
|
** Last update : 26-Sep-1999
|
||||||
|
**
|
||||||
|
** Note: (c) 1998-1999 by Maarten Bekers
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
uses Os2Base;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
uses Windows;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Type THandle = Longint;
|
||||||
|
DWORD = Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
{$IFDEF FPC}
|
||||||
|
Type THandle = Handle;
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
type TSysEventObj = Object
|
||||||
|
{$IFDEF OS2}
|
||||||
|
SemHandle: HEV;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SemHandle: THandle;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
constructor init;
|
||||||
|
destructor done;
|
||||||
|
|
||||||
|
procedure DisposeEvent;
|
||||||
|
procedure SignalEvent;
|
||||||
|
procedure ResetEvent;
|
||||||
|
function CreateEvent(InitialState: Boolean): Boolean;
|
||||||
|
function WaitForEvent(TimeOut: Longint): Boolean;
|
||||||
|
end; { TSysEventObj }
|
||||||
|
|
||||||
|
Type PSysEventObj = ^TSysEventObj;
|
||||||
|
|
||||||
|
type TExclusiveObj = Object
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Exclusive: PHMtx;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Exclusive: PRTLCriticalSection;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
procedure CreateExclusive;
|
||||||
|
procedure DisposeExclusive;
|
||||||
|
|
||||||
|
procedure EnterExclusive;
|
||||||
|
procedure LeaveExclusive;
|
||||||
|
end; { TExclusiveObj }
|
||||||
|
|
||||||
|
Type PExclusiveObj = ^TExclusiveObj;
|
||||||
|
|
||||||
|
|
||||||
|
type TThreadsObj = Object
|
||||||
|
ThreadHandle : THandle;
|
||||||
|
ThreadID : DWORD;
|
||||||
|
ThreadClosed : Boolean;
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function CreateThread(StackSize : Longint;
|
||||||
|
CallProc,
|
||||||
|
Parameters : Pointer;
|
||||||
|
CreationFlags: Longint): Boolean;
|
||||||
|
procedure CloseThread;
|
||||||
|
procedure TerminateThread(ExitCode: Longint);
|
||||||
|
end; { TThreadsObj }
|
||||||
|
|
||||||
|
Type PThreadsObj = ^TThreadsObj;
|
||||||
|
|
||||||
|
procedure ExitThisThread;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TSysEventObj.Init;
|
||||||
|
begin
|
||||||
|
SemHandle := 0;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TSysEventObj.Done;
|
||||||
|
begin
|
||||||
|
if Longint(SemHandle) <> -1 then
|
||||||
|
begin
|
||||||
|
SignalEvent;
|
||||||
|
DisposeEvent;
|
||||||
|
end; { if }
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TSysEventObj.CreateEvent(InitialState: Boolean): Boolean;
|
||||||
|
{$IFDEF OS2}
|
||||||
|
var Returncode: longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
CreateEvent := true;
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
SemHandle := Windows.CreateEvent(nil, true, InitialState, nil);
|
||||||
|
if Longint(SemHandle) = -1 then CreateEvent := false;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
returncode := DosCreateEventSem(nil, SemHandle, 0, InitialState);
|
||||||
|
CreateEvent := (returncode=0);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. CreateEvent }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TSysEventObj.SignalEvent;
|
||||||
|
{$IFDEF OS2}
|
||||||
|
var RC: Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if Longint(SemHandle) <> -1 then
|
||||||
|
SetEvent(SemHandle);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
if SemHandle <> -1 then
|
||||||
|
RC := DosPostEventSem(SemHandle);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. SignalEvent }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TSysEventObj.ResetEvent;
|
||||||
|
{$IFDEF OS2}
|
||||||
|
var Flag: Longint;
|
||||||
|
RC : Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if SemHandle <> THandle(-1) then
|
||||||
|
Windows.ResetEvent(SemHandle);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Flag := 0;
|
||||||
|
if SemHandle <> -1 then
|
||||||
|
RC := DosResetEventSem(SemHandle, Flag);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. ResetEvent }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TSysEventObj.WaitForEvent(TimeOut: Longint): Boolean;
|
||||||
|
var ReturnCode: Longint;
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Flag : Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if SemHandle <> THandle(-1) then
|
||||||
|
ReturnCode := WaitForSingleObject(SemHandle, Timeout)
|
||||||
|
else ReturnCode := 0;
|
||||||
|
|
||||||
|
WaitForEvent := (ReturnCode = WAIT_OBJECT_0);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
if SemHandle <> -1 then
|
||||||
|
ReturnCode := DosWaitEventSem(SemHandle, TimeOut);
|
||||||
|
|
||||||
|
Flag := 0;
|
||||||
|
DosResetEventSem(SemHandle, Flag);
|
||||||
|
WaitForEvent := (ReturnCode = 0);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { func. WaitForEvent }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TSysEventObj.DisposeEvent;
|
||||||
|
{$IFDEF OS2}
|
||||||
|
var Flag: Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if SemHandle <> THandle(-1) then CloseHandle(SemHandle);
|
||||||
|
SemHandle := 0;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Flag := 0;
|
||||||
|
if SemHandle <> -1 then DosCloseEventSem(SemHandle);
|
||||||
|
SemHandle := -1;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. DisposeEvent }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TExclusiveObj.Init;
|
||||||
|
begin
|
||||||
|
Exclusive := nil;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TExclusiveObj.Done;
|
||||||
|
begin
|
||||||
|
if Exclusive <> nil then
|
||||||
|
DisposeExclusive;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TExclusiveObj.CreateExclusive;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
New(Exclusive);
|
||||||
|
InitializeCriticalSection(Exclusive^);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
New(Exclusive);
|
||||||
|
DosCreateMutexSem(nil, Exclusive^, dcmw_Wait_All, false);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. CreateExclusive }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TExclusiveObj.DisposeExclusive;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if Exclusive <> nil then
|
||||||
|
begin
|
||||||
|
DeleteCriticalSection(Exclusive^);
|
||||||
|
Dispose(Exclusive);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Exclusive := nil;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
if Exclusive <> nil then
|
||||||
|
begin
|
||||||
|
DosCloseMutexSem(Exclusive^);
|
||||||
|
Dispose(Exclusive);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Exclusive := nil;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. DisposeExclusive }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TExclusiveObj.EnterExclusive;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
EnterCriticalSection(Exclusive^);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosRequestMutexSem(Exclusive^, sem_Indefinite_Wait);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. EnterExclusive }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TExclusiveObj.LeaveExclusive;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
LeaveCriticalSection(Exclusive^);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosReleaseMutexSem(Exclusive^);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. LeaveExclusive }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TThreadsObj.Init;
|
||||||
|
begin
|
||||||
|
ThreadHandle := 0;
|
||||||
|
ThreadId := 0;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TThreadsObj.Done;
|
||||||
|
begin
|
||||||
|
CloseThread;
|
||||||
|
ThreadHandle := 0;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TThreadsObj.CreateThread(StackSize : Longint;
|
||||||
|
CallProc,
|
||||||
|
Parameters : Pointer;
|
||||||
|
CreationFlags: Longint): Boolean;
|
||||||
|
var ReturnCode: Longint;
|
||||||
|
begin
|
||||||
|
ThreadClosed := FALSE;
|
||||||
|
|
||||||
|
{$IFNDEF VirtualPascal}
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
ThreadHandle := Windows.CreateThread(nil, { Security attrs }
|
||||||
|
StackSize, { Stack size }
|
||||||
|
CallProc, { Actual procedure }
|
||||||
|
Parameters, { Parameters }
|
||||||
|
CreationFlags, { Creation flags }
|
||||||
|
ThreadID); { Thread ID ?? }
|
||||||
|
|
||||||
|
CreateThread := (ThreadHandle <> THandle(-1));
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
ReturnCode :=
|
||||||
|
DosCreateThread(ThreadHandle, { ThreadHandle }
|
||||||
|
CallProc, { Actual procedure }
|
||||||
|
Longint(Parameters), { Parameters }
|
||||||
|
CreationFlags, { Creation flags }
|
||||||
|
StackSize); { Stacksize }
|
||||||
|
|
||||||
|
CreateThread := (ReturnCode = 0);
|
||||||
|
if ReturnCode <> 0 then ThreadHandle := -1;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF LINUX}
|
||||||
|
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{$ELSE}
|
||||||
|
ThreadHandle := BeginThread(nil, StackSize, CallProc, Parameters, 0, ReturnCode);
|
||||||
|
CreateThread := (ThreadHandle > THandle(-1));
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. CreateThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TThreadsObj.CloseThread;
|
||||||
|
begin
|
||||||
|
ThreadClosed := TRUE;
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if ThreadHandle <> Thandle(-1) then CloseHandle(ThreadHandle);
|
||||||
|
ThreadHandle := 0;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
{!! DosClose() on a ThreadHandle doesn't work - will eventually close }
|
||||||
|
{!! other handles ... }
|
||||||
|
{ if ThreadHandle <> -1 then DosClose(ThreadHandle); }
|
||||||
|
ThreadHandle := -1;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. CloseThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TThreadsObj.TerminateThread(ExitCode: Longint);
|
||||||
|
begin
|
||||||
|
ThreadClosed := TRUE;
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
if ThreadHandle <> Thandle(-1) then
|
||||||
|
Windows.TerminateThread(ThreadHandle, ExitCode);
|
||||||
|
ThreadHandle := 00;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
if ThreadHandle <> -1 then DosKillThread(ThreadHandle);
|
||||||
|
ThreadHandle := -1;
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. TerminateThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure ExitThisThread;
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Windows.ExitThread(0);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Os2Base.DosExit(exit_Thread, 0);
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. ExitThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,824 @@
|
||||||
|
unit W32SNGL;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.1, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.15 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.02
|
||||||
|
** Created : 09-Sep-1999
|
||||||
|
** Last update : 21-Jul-2001
|
||||||
|
**
|
||||||
|
** Note: (c) 1998-2000 by Maarten Bekers
|
||||||
|
**
|
||||||
|
** Note2: The problem with this approach that we only retrieve the data when
|
||||||
|
** we want to. If data arrives and we dont call either Com_ReadBlock(),
|
||||||
|
** Com_CharAvail or Com_GetBufferStatus() we dont receive the data.
|
||||||
|
** Therefore, we rely on Windows to actually buffer the data. We do this
|
||||||
|
** by calling SetupComm() with the buffer-sizes as defined by
|
||||||
|
** Win32OutBufSize and Win32InBufSize.
|
||||||
|
** If you want to avoid this, you can implement another mutex that you
|
||||||
|
** let set by Win32's API calls SetEventMask() and WaitCommEvent().
|
||||||
|
** That way, you can also monitor other events which would eliminate
|
||||||
|
** some overhead. In general, this approach will suffice.
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses Windows, Combase, BufUnit, Threads
|
||||||
|
{$IFDEF VirtualPascal}
|
||||||
|
,Use32
|
||||||
|
{$ENDIF};
|
||||||
|
|
||||||
|
Const DataTimeout = 20000; { Wait max. 20 secs }
|
||||||
|
|
||||||
|
InBufSize = 1024 * 32;
|
||||||
|
OutBufSize = 1024 * 32;
|
||||||
|
Win32OutBufSize = 1024 * 3;
|
||||||
|
Win32InBufSize = 1024 * 3;
|
||||||
|
|
||||||
|
|
||||||
|
type TWin32Obj = Object(TCommObj)
|
||||||
|
DataProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
ThreadsInitted: Boolean; { Are the thread(s) up and running? }
|
||||||
|
|
||||||
|
SaveHandle : THandle;
|
||||||
|
|
||||||
|
InitPortNr : Longint;
|
||||||
|
InitHandle : Longint;
|
||||||
|
|
||||||
|
ReadOL : TOverLapped; { Overlapped structure for ReadFile }
|
||||||
|
WriteOL : TOverLapped; { Overlapped structure for WriteFile }
|
||||||
|
|
||||||
|
InBuffer : ^BufArrayObj; { Buffer system internally used }
|
||||||
|
OutBuffer : ^BufArrayObj;
|
||||||
|
|
||||||
|
ReadEvent : PSysEventObj; { Event set by ReadFile overlapped routine }
|
||||||
|
WriteEvent : PSysEventObj; { Event set by WriteFile overlapped routine }
|
||||||
|
|
||||||
|
DoTxEvent : PSysEventObj;{ Event manually set when we have to transmit }
|
||||||
|
DoRxEvent : PSysEventObj; { Event manually set when we want data }
|
||||||
|
|
||||||
|
DataClosedEvent: PSysEventObj; { Event set when the Tx thread is closed }
|
||||||
|
|
||||||
|
CriticalTx : PExclusiveObj; { Critical sections }
|
||||||
|
CriticalRx : PExclusiveObj;
|
||||||
|
|
||||||
|
DataThread : PThreadsObj;
|
||||||
|
EndThreads : Boolean; { Set to true when we have to end the threads }
|
||||||
|
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
||||||
|
function Com_GetChar: Char; virtual;
|
||||||
|
function Com_CharAvail: Boolean; virtual;
|
||||||
|
function Com_Carrier: Boolean; virtual;
|
||||||
|
function Com_SendChar(C: Char): Boolean; virtual;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
||||||
|
function Com_GetBPSrate: Longint; virtual;
|
||||||
|
function Com_GetHandle: Longint; virtual;
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
||||||
|
procedure Com_Close; virtual;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
||||||
|
procedure Com_SetDtr(State: Boolean); virtual;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
||||||
|
procedure Com_PurgeInBuffer; virtual;
|
||||||
|
procedure Com_PurgeOutBuffer; virtual;
|
||||||
|
procedure Com_FlushOutBuffer(Slice: SliceProc); virtual;
|
||||||
|
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
||||||
|
|
||||||
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
||||||
|
procedure Com_DataProc(var TempPtr: Pointer); virtual;
|
||||||
|
|
||||||
|
function Com_StartThread: Boolean;
|
||||||
|
procedure Com_InitVars;
|
||||||
|
procedure Com_StopThread;
|
||||||
|
procedure Com_InitDelayTimes;
|
||||||
|
end; { object TWin32Obj }
|
||||||
|
|
||||||
|
type PWin32Obj = ^TWin32Obj;
|
||||||
|
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses SysUtils;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$I WINDEF.FPC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
const
|
||||||
|
dcb_Binary = $00000001;
|
||||||
|
dcb_ParityCheck = $00000002;
|
||||||
|
dcb_OutxCtsFlow = $00000004;
|
||||||
|
dcb_OutxDsrFlow = $00000008;
|
||||||
|
dcb_DtrControlMask = $00000030;
|
||||||
|
dcb_DtrControlDisable = $00000000;
|
||||||
|
dcb_DtrControlEnable = $00000010;
|
||||||
|
dcb_DtrControlHandshake = $00000020;
|
||||||
|
dcb_DsrSensivity = $00000040;
|
||||||
|
dcb_TXContinueOnXoff = $00000080;
|
||||||
|
dcb_OutX = $00000100;
|
||||||
|
dcb_InX = $00000200;
|
||||||
|
dcb_ErrorChar = $00000400;
|
||||||
|
dcb_NullStrip = $00000800;
|
||||||
|
dcb_RtsControlMask = $00003000;
|
||||||
|
dcb_RtsControlDisable = $00000000;
|
||||||
|
dcb_RtsControlEnable = $00001000;
|
||||||
|
dcb_RtsControlHandshake = $00002000;
|
||||||
|
dcb_RtsControlToggle = $00003000;
|
||||||
|
dcb_AbortOnError = $00004000;
|
||||||
|
dcb_Reserveds = $FFFF8000;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TWin32Obj.Init;
|
||||||
|
begin
|
||||||
|
inherited Init;
|
||||||
|
|
||||||
|
InitPortNr := -1;
|
||||||
|
InitHandle := -1;
|
||||||
|
ThreadsInitted := false;
|
||||||
|
Com_Initvars;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TWin32Obj.Done;
|
||||||
|
begin
|
||||||
|
inherited done;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_DataProc(var TempPtr: Pointer);
|
||||||
|
var Success : Boolean;
|
||||||
|
Props : TCommProp;
|
||||||
|
ObjectCode : Longint;
|
||||||
|
ReturnCode : Longint;
|
||||||
|
DidRead : DWORD;
|
||||||
|
Written : DWORD;
|
||||||
|
BlockLen : DWORD;
|
||||||
|
ObjectArray : Array[0..1] of THandle;
|
||||||
|
TryReading : Boolean;
|
||||||
|
Stats : TComStat;
|
||||||
|
ErrMask : DWORD;
|
||||||
|
begin
|
||||||
|
ObjectArray[0] := DoTxEvent^.SemHandle;
|
||||||
|
ObjectArray[1] := DoRxEvent^.SemHandle;
|
||||||
|
|
||||||
|
repeat
|
||||||
|
ObjectCode := WaitForMultipleObjects(2,
|
||||||
|
@ObjectArray,
|
||||||
|
false,
|
||||||
|
DataTimeOut);
|
||||||
|
if EndThreads then EXIT;
|
||||||
|
|
||||||
|
{-----------------------------------------------------------------------}
|
||||||
|
{-------------------------- Receive signalled --------------------------}
|
||||||
|
{-----------------------------------------------------------------------}
|
||||||
|
if (ObjectCode - WAIT_OBJECT_0) = 1 then { DoReceive }
|
||||||
|
begin
|
||||||
|
DidRead := 00;
|
||||||
|
if (EndThreads) then EXIT;
|
||||||
|
|
||||||
|
{-- Make sure there is something to be read ------------------------}
|
||||||
|
ErrMask := 0;
|
||||||
|
TryReading := FALSE;
|
||||||
|
|
||||||
|
if ClearCommError(SaveHandle, ErrMask, @Stats) then
|
||||||
|
if Stats.cbInQue > 0 then
|
||||||
|
TryReading := TRUE;
|
||||||
|
|
||||||
|
|
||||||
|
{----------------- Start reading the gathered date -----------------}
|
||||||
|
if TryReading then
|
||||||
|
begin
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
|
||||||
|
FillChar(Props, SizeOf(TCommProp), 0);
|
||||||
|
if GetCommProperties(SaveHandle, Props) then
|
||||||
|
if InBuffer^.BufRoom > 0 then
|
||||||
|
begin
|
||||||
|
BlockLen := Props.dwCurrentRxQueue;
|
||||||
|
{ We want the complete BUFFER size, and not }
|
||||||
|
{ the actual queue size. The queue may have }
|
||||||
|
{ grown since last query, and we always }
|
||||||
|
{ want as much data as possible }
|
||||||
|
|
||||||
|
if Longint(BlockLen) > InBuffer^.BufRoom then
|
||||||
|
BlockLen := InBuffer^.BufRoom;
|
||||||
|
|
||||||
|
Success := ReadFile(SaveHandle,
|
||||||
|
InBuffer^.TmpBuf,
|
||||||
|
BlockLen,
|
||||||
|
DidRead,
|
||||||
|
@ReadOL);
|
||||||
|
|
||||||
|
if NOT Success then
|
||||||
|
begin
|
||||||
|
ReturnCode := GetLastError;
|
||||||
|
|
||||||
|
if ReturnCode = ERROR_IO_PENDING then
|
||||||
|
begin
|
||||||
|
ReturnCode := WaitForSingleObject(ReadOL.hEvent, DataTimeOut);
|
||||||
|
|
||||||
|
if ReturnCode = WAIT_OBJECT_0 then
|
||||||
|
begin
|
||||||
|
GetOverLappedResult(SaveHandle, ReadOL, DidRead, false);
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end
|
||||||
|
else GetOverlappedResult(SaveHandle, ReadOL, DidRead, false);
|
||||||
|
|
||||||
|
if DidRead > 00 then
|
||||||
|
begin
|
||||||
|
InBuffer^.Put(InBuffer^.TmpBuf, DidRead);
|
||||||
|
DoRxEvent^.ResetEvent;
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { try reading }
|
||||||
|
end; { DoReceive call }
|
||||||
|
|
||||||
|
{-----------------------------------------------------------------------}
|
||||||
|
{-------------------------- Transmit signalled -------------------------}
|
||||||
|
{-----------------------------------------------------------------------}
|
||||||
|
if (ObjectCode - WAIT_OBJECT_0) = 0 then { DoTransmit }
|
||||||
|
begin
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
DoTxEvent^.ResetEvent;
|
||||||
|
|
||||||
|
if OutBuffer^.BufUsed > 00 then
|
||||||
|
begin
|
||||||
|
Written := 00;
|
||||||
|
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf, OutBuffer^.BufUsed, false);
|
||||||
|
|
||||||
|
Success := WriteFile(SaveHandle,
|
||||||
|
OutBuffer^.TmpBuf,
|
||||||
|
BlockLen,
|
||||||
|
Written,
|
||||||
|
@WriteOL);
|
||||||
|
if NOT Success then
|
||||||
|
begin
|
||||||
|
ReturnCode := GetLastError;
|
||||||
|
|
||||||
|
if ReturnCode = ERROR_IO_PENDING then
|
||||||
|
begin
|
||||||
|
ReturnCode := WaitForSingleObject(WriteOL.hEvent, DataTimeOut);
|
||||||
|
|
||||||
|
if ReturnCode = WAIT_OBJECT_0 then
|
||||||
|
begin
|
||||||
|
if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
|
||||||
|
begin
|
||||||
|
ResetEvent(WriteOL.hEvent);
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end; { result is pending }
|
||||||
|
end { if }
|
||||||
|
else begin
|
||||||
|
|
||||||
|
if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
|
||||||
|
begin
|
||||||
|
ResetEvent(WriteOL.hEvent);
|
||||||
|
end; { if }
|
||||||
|
end; { if (did succeed) }
|
||||||
|
|
||||||
|
{-- remove the data from the buffer, but only remove the data ---}
|
||||||
|
{-- thats actually written --------------------------------------}
|
||||||
|
ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf, Written, true);
|
||||||
|
if ReturnCode <> Longint(Written) then
|
||||||
|
begin
|
||||||
|
{ not everything is removed! }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
{-- if theres data in the buffer left, run this event again -----}
|
||||||
|
if Written <> BlockLen then
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
end; { DoTransmit call }
|
||||||
|
|
||||||
|
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
DataClosedEvent^.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. ComDataProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_StartThread: Boolean;
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
EndThreads := false;
|
||||||
|
if ThreadsInitted then EXIT;
|
||||||
|
ThreadsInitted := true;
|
||||||
|
|
||||||
|
{----------------------- Create all the events ----------------------------}
|
||||||
|
New(ReadEvent, Init);
|
||||||
|
if NOT ReadEvent^.CreateEvent(true) then EXIT;
|
||||||
|
|
||||||
|
New(WriteEvent, Init);
|
||||||
|
if NOT WriteEvent^.CreateEvent(true) then EXIT;
|
||||||
|
|
||||||
|
New(DoTxEvent, Init);
|
||||||
|
if NOT DoTxEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(DoRxEvent, Init);
|
||||||
|
if NOT DoRxEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(DataClosedEvent, Init);
|
||||||
|
if NOT DataClosedEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
{-------------- Startup the buffers and overlapped events -----------------}
|
||||||
|
FillChar(WriteOL, SizeOf(tOverLapped), 0);
|
||||||
|
FillChar(ReadOL, SizeOf(tOverLapped), 0);
|
||||||
|
WriteOl.hEvent := WriteEvent^.SemHandle;
|
||||||
|
ReadOl.hEvent := ReadEvent^.SemHandle;
|
||||||
|
|
||||||
|
New(InBuffer, Init(InBufSize));
|
||||||
|
New(OutBuffer, Init(OutBufSize));
|
||||||
|
|
||||||
|
{-------------------- Startup the critical section objects ----------------}
|
||||||
|
New(CriticalTx, Init);
|
||||||
|
CriticalTx^.CreateExclusive;
|
||||||
|
|
||||||
|
New(CriticalRx, Init);
|
||||||
|
CriticalRx^.CreateExclusive;
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate tx / rx thread -------------------}
|
||||||
|
New(DataThread, Init);
|
||||||
|
if NOT DataThread^.CreateThread(16384, { Stack size }
|
||||||
|
DataProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
Result := true;
|
||||||
|
end; { proc. Com_StartThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_InitVars;
|
||||||
|
begin
|
||||||
|
DoTxEvent := nil;
|
||||||
|
DoRxEvent := nil;
|
||||||
|
DataClosedEvent := nil;
|
||||||
|
DataThread := nil;
|
||||||
|
ReadEvent := nil;
|
||||||
|
WriteEvent := nil;
|
||||||
|
|
||||||
|
InBuffer := nil;
|
||||||
|
OutBuffer := nil;
|
||||||
|
CriticalRx := nil;
|
||||||
|
CriticalTx := nil;
|
||||||
|
end; { proc. Com_InitVars }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_StopThread;
|
||||||
|
begin
|
||||||
|
EndThreads := true;
|
||||||
|
ThreadsInitted := false;
|
||||||
|
|
||||||
|
if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
|
||||||
|
if DoTxEvent <> nil then DoRxEvent^.SignalEvent;
|
||||||
|
if DataThread <> nil then DataThread^.CloseThread;
|
||||||
|
|
||||||
|
if DataClosedEvent <> nil then
|
||||||
|
if NOT DataClosedEvent^.WaitForEvent(1000) then
|
||||||
|
DataThread^.TerminateThread(0);
|
||||||
|
|
||||||
|
if DataThread <> nil then Dispose(DataThread, Done);
|
||||||
|
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
|
||||||
|
if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
|
||||||
|
if DataClosedEvent <> nil then Dispose(DataClosedEvent, Done);
|
||||||
|
if ReadEvent <> nil then Dispose(ReadEvent, Done);
|
||||||
|
if WriteEvent <> nil then Dispose(WriteEvent, Done);
|
||||||
|
|
||||||
|
if CriticalTx <> nil then Dispose(CriticalTx, Done);
|
||||||
|
if CriticalRx <> nil then Dispose(CriticalRx, Done);
|
||||||
|
|
||||||
|
if InBuffer <> nil then Dispose(InBuffer, Done);
|
||||||
|
if OutBuffer <> nil then Dispose(OutBuffer, Done);
|
||||||
|
|
||||||
|
Com_InitVars;
|
||||||
|
end; { proc. Com_StopThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_InitDelayTimes;
|
||||||
|
var CommTimeOut: TCommTimeouts;
|
||||||
|
RC : Longint;
|
||||||
|
begin
|
||||||
|
FillChar(CommTimeOut, SizeOf(TCommTimeOuts), 00);
|
||||||
|
CommTimeOut.ReadIntervalTimeout := MAXDWORD;
|
||||||
|
|
||||||
|
if NOT SetCommTimeOuts(SaveHandle, CommTimeOut) then
|
||||||
|
begin
|
||||||
|
RC := GetLastError;
|
||||||
|
ErrorStr := 'Error setting communications timeout: #'+IntToStr(RC) + ' / ' + SysErrorMessage(rc);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
end; { proc. InitDelayTimes }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_GetHandle: Longint;
|
||||||
|
begin
|
||||||
|
Result := SaveHandle;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_OpenQuick(Handle: Longint);
|
||||||
|
var LastError: Longint;
|
||||||
|
begin
|
||||||
|
SaveHandle := Handle;
|
||||||
|
InitHandle := Handle;
|
||||||
|
|
||||||
|
FillChar(ReadOl, SizeOf(ReadOl), 00);
|
||||||
|
FillChar(WriteOl, SizeOf(WriteOl), 00);
|
||||||
|
|
||||||
|
if NOT SetupComm(Com_GetHandle, Win32InBufSize, Win32OutBufSize) then
|
||||||
|
begin
|
||||||
|
LastError := GetLastError;
|
||||||
|
|
||||||
|
ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Com_InitDelayTimes;
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
Com_SetLine(-1, 'N', 8, 1);
|
||||||
|
end; { proc. TWin32Obj.Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
var TempSave : THandle;
|
||||||
|
Security : TSECURITYATTRIBUTES;
|
||||||
|
LastError : Longint;
|
||||||
|
begin
|
||||||
|
InitPortNr := Comport;
|
||||||
|
|
||||||
|
FillChar(ReadOl, SizeOf(ReadOl), 00);
|
||||||
|
FillChar(WriteOl, SizeOf(WriteOl), 00);
|
||||||
|
|
||||||
|
FillChar(Security, SizeOf(TSECURITYATTRIBUTES), 0);
|
||||||
|
Security.nLength := SizeOf(TSECURITYATTRIBUTES);
|
||||||
|
Security.lpSecurityDescriptor := nil;
|
||||||
|
Security.bInheritHandle := true;
|
||||||
|
|
||||||
|
TempSave := CreateFile(PChar('\\.\COM' + IntToStr(ComPort)),
|
||||||
|
GENERIC_READ or GENERIC_WRITE,
|
||||||
|
0,
|
||||||
|
@Security, { No Security }
|
||||||
|
OPEN_EXISTING, { Creation action }
|
||||||
|
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
|
||||||
|
0); { No template }
|
||||||
|
LastError := GetLastError;
|
||||||
|
if LastError <> 0 then
|
||||||
|
ErrorStr := 'Unable to open communications port';
|
||||||
|
|
||||||
|
SaveHandle := TempSave;
|
||||||
|
Result := (TempSave <> INVALID_HANDLE_VALUE);
|
||||||
|
|
||||||
|
if Result then { Make sure that "CharAvail" isn't going to wait }
|
||||||
|
begin
|
||||||
|
Com_InitDelayTimes;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
if NOT SetupComm(Com_GetHandle, Win32InBufSize, Win32OutBufSize) then
|
||||||
|
begin
|
||||||
|
LastError := GetLastError;
|
||||||
|
|
||||||
|
ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_Open := Com_OpenKeep(Comport);
|
||||||
|
Com_SetLine(Baudrate, Parity, DataBits, StopBits);
|
||||||
|
end; { func. TWin32Obj.Com_OpenCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
var DCB : TDCB;
|
||||||
|
BPSID : Longint;
|
||||||
|
begin
|
||||||
|
if BpsRate = 11520 then { small fix for EleBBS inability to store the bps }
|
||||||
|
BpsRate := 115200; { rate in anything larger than a 16-bit integer }
|
||||||
|
|
||||||
|
GetCommState(Com_GetHandle, DCB);
|
||||||
|
|
||||||
|
if NOT (Parity in ['N', 'E', 'O', 'M']) then Parity := 'N';
|
||||||
|
if BpsRate >= 0 then dcb.BaudRate := BpsRate;
|
||||||
|
dcb.StopBits := ONESTOPBIT;
|
||||||
|
|
||||||
|
Case Parity of
|
||||||
|
'N' : dcb.Parity := NOPARITY;
|
||||||
|
'E' : dcb.Parity := EVENPARITY;
|
||||||
|
'O' : dcb.Parity := ODDPARITY;
|
||||||
|
'M' : dcb.Parity := MARKPARITY;
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
Case StopBits of
|
||||||
|
1 : dcb.StopBits := ONESTOPBIT;
|
||||||
|
2 : dcb.StopBits := TWOSTOPBITS;
|
||||||
|
3 : dcb.StopBits := ONE5STOPBITS;
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
dcb.ByteSize := DataBits;
|
||||||
|
dcb.Flags := dcb.Flags OR dcb_Binary OR Dcb_DtrControlEnable;
|
||||||
|
|
||||||
|
if not SetCommState (Com_GetHandle, DCB) then
|
||||||
|
begin
|
||||||
|
BPSId := GetLastError;
|
||||||
|
|
||||||
|
ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId);
|
||||||
|
end; { if }
|
||||||
|
end; { proc. TWin32Obj.Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_Close;
|
||||||
|
begin
|
||||||
|
if DontClose then EXIT;
|
||||||
|
|
||||||
|
if DWORD(Com_GetHandle) <> INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
Com_StopThread;
|
||||||
|
CloseHandle(Com_GetHandle);
|
||||||
|
|
||||||
|
SaveHandle := INVALID_HANDLE_VALUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end; { func. TWin32Obj.Com_CloseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_SendChar(C: Char): Boolean;
|
||||||
|
var Written: Longint;
|
||||||
|
begin
|
||||||
|
Com_SendBlock(C, SizeOf(C), Written);
|
||||||
|
Com_SendChar := (Written = SizeOf(c));
|
||||||
|
end; { proc. TWin32Obj.Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_GetChar: Char;
|
||||||
|
var Reads: Longint;
|
||||||
|
begin
|
||||||
|
Com_ReadBlock(Result, SizeOf(Result), Reads);
|
||||||
|
end; { func. TWin32Obj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
begin
|
||||||
|
if OutBuffer^.BufRoom < BlockLen then
|
||||||
|
repeat
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
Written := OutBuffer^.Put(Block, BlockLen);
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
end; { proc. TWin32Obj.Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < BlockLen then
|
||||||
|
begin
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
|
||||||
|
while (InBuffer^.BufUsed < BlockLen) AND (Com_Carrier) do
|
||||||
|
begin
|
||||||
|
Sleep(1);
|
||||||
|
|
||||||
|
if Com_CharAvail then
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
end; { while }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
Reads := InBuffer^.Get(Block, BlockLen, true);
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { proc. TWin32Obj.Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_CharAvail: Boolean;
|
||||||
|
var Props : TComStat;
|
||||||
|
ErrMask : DWORD;
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < 1 then
|
||||||
|
begin
|
||||||
|
ErrMask := 0;
|
||||||
|
|
||||||
|
if ClearCommError(Com_GetHandle, ErrMask, @Props) then
|
||||||
|
if Props.cbInQue > 0 then
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Result := (InBuffer^.BufUsed > 0);
|
||||||
|
end; { func. TWin32Obj.Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_Carrier: Boolean;
|
||||||
|
var Status: DWORD;
|
||||||
|
begin
|
||||||
|
if Com_GetHandle <> INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
GetCommModemStatus(Com_GetHandle,
|
||||||
|
Status);
|
||||||
|
|
||||||
|
Result := (Status AND MS_RLSD_ON) <> 00;
|
||||||
|
end
|
||||||
|
else Result := FALSE;
|
||||||
|
end; { func. TWin32Obj.Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
var Data: DWORD;
|
||||||
|
begin
|
||||||
|
GetCommModemStatus(Com_GetHandle, Data);
|
||||||
|
|
||||||
|
ModemStatus := ModemStatus and $0F;
|
||||||
|
ModemStatus := ModemStatus or Byte(Data);
|
||||||
|
end; { proc. TWin32Obj.Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetDtr(State: Boolean);
|
||||||
|
begin
|
||||||
|
if State then
|
||||||
|
EscapeCommFunction(Com_GetHandle, SETDTR)
|
||||||
|
else EscapeCommFunction(Com_GetHandle, CLRDTR);
|
||||||
|
end; { proc. TWin32Obj.Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_GetBpsRate: Longint;
|
||||||
|
var DCB : TDCB;
|
||||||
|
begin
|
||||||
|
GetCommState(Com_GetHandle, DCB);
|
||||||
|
|
||||||
|
Com_GetBpsRate := dcb.Baudrate;
|
||||||
|
end; { func. TWin32Obj.Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
var Stats : TComStat;
|
||||||
|
ErrMask : DWORD;
|
||||||
|
begin
|
||||||
|
if ClearCommError(Com_GetHandle, ErrMask, @Stats) then
|
||||||
|
begin
|
||||||
|
if Stats.cbInQue > 0 then
|
||||||
|
begin
|
||||||
|
DoRxEvent^.SignalEvent;
|
||||||
|
Sleep(1);
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
|
||||||
|
InFree := InBuffer^.BufRoom;
|
||||||
|
OutFree := OutBuffer^.BufRoom;
|
||||||
|
InUsed := InBuffer^.BufUsed;
|
||||||
|
OutUsed := OutBuffer^.BufUsed;
|
||||||
|
end; { proc. TWin32Obj.Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
|
||||||
|
InBuffer^.Clear;
|
||||||
|
PurgeComm(Com_GetHandle, PURGE_RXCLEAR);
|
||||||
|
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { proc. TWin32Obj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
|
||||||
|
OutBuffer^.Clear;
|
||||||
|
PurgeComm(Com_GetHandle, PURGE_TXCLEAR);
|
||||||
|
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
end; { proc. TWin32Obj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Result := OutBuffer^.BufRoom >= BlockLen;
|
||||||
|
end; { func. ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_PauseCom(CloseCom: Boolean);
|
||||||
|
begin
|
||||||
|
if CloseCom then Com_Close
|
||||||
|
else Com_StopThread;
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
begin
|
||||||
|
if OpenCom then
|
||||||
|
begin
|
||||||
|
if InitPortNr <> -1 then Com_OpenKeep(InitPortNr)
|
||||||
|
else Com_OpenQuick(InitHandle);
|
||||||
|
end
|
||||||
|
else InitFailed := NOT Com_StartThread;
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_FlushOutBuffer(Slice: SliceProc);
|
||||||
|
begin
|
||||||
|
Windows.FlushFileBuffers(Com_GetHandle);
|
||||||
|
|
||||||
|
inherited Com_FlushOutBuffer(Slice);
|
||||||
|
end; { proc. Com_FlushOutBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
var DCB : TDCB;
|
||||||
|
BPSID : Longint;
|
||||||
|
begin
|
||||||
|
GetCommState(Com_GetHandle, DCB);
|
||||||
|
|
||||||
|
if Hard then
|
||||||
|
dcb.Flags := dcb.Flags OR NOT dcb_OutxCtsFlow OR NOT dcb_RtsControlHandshake;
|
||||||
|
|
||||||
|
if SoftTX then
|
||||||
|
dcb.Flags := dcb.Flags OR NOT dcb_OutX;
|
||||||
|
|
||||||
|
if SoftRX then
|
||||||
|
dcb.Flags := dcb.Flags OR NOT dcb_InX;
|
||||||
|
|
||||||
|
if not SetCommState(Com_GetHandle, DCB) then
|
||||||
|
begin
|
||||||
|
BPSId := GetLastError;
|
||||||
|
|
||||||
|
ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
Com_InitDelayTimes;
|
||||||
|
end; { proc. Com_SetFlow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
||||||
|
begin
|
||||||
|
DataProcPtr := ReadPtr;
|
||||||
|
end; { proc. Com_SetDataProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,205 @@
|
||||||
|
unit W32sock;
|
||||||
|
{&Orgname+}
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** WINDOWS TCP/IP routines
|
||||||
|
**
|
||||||
|
** Copyright (c) 1998 by Thomas W. Mueller
|
||||||
|
**
|
||||||
|
** Created : 24-Oct-1998
|
||||||
|
** Last update : 20-Feb-2000
|
||||||
|
**
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses
|
||||||
|
Windows,
|
||||||
|
SockDef;
|
||||||
|
|
||||||
|
type
|
||||||
|
u_char = Char;
|
||||||
|
u_short = Word;
|
||||||
|
u_int = Integer;
|
||||||
|
u_long = Longint;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
type pInteger = ^Integer;
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
||||||
|
{ Socket function prototypes }
|
||||||
|
|
||||||
|
function accept(_s: ULONG; _addr: pSockAddr; _addrlen: PInteger): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function bind(_s: ULONG; _addr: pSockAddr; _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function connect(_s: ULONG; _name: pSockAddr; _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function closesocket(s: ULONG): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
|
||||||
|
timeout: PTimeVal): Longint; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function ioctlsocket(_s: ULONG; _cmd: Longint; var _arg: ULONG): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getpeername(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getsockname(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar; var _optlen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function htonl(_hostlong: ULONG): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function htons(_hostshort: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function inet_addr(_cp: PChar): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function inet_ntoa(_inaddr: tIn_Addr): PChar; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function listen(_s: ULONG; _backlog: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function ntohl(_netlong: ULONG): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function ntohs(_netshort: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function recv(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
|
||||||
|
function recvfrom(s: ULONG; _Buf: pointer; _len, _flags: Integer;
|
||||||
|
var _from: TSockAddr; var _fromlen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function send(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function sendto(_s: ULONG; _Buf: pointer; _len, _flags: Integer; var _addrto: TSockAddr;
|
||||||
|
_tolen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function setsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar;
|
||||||
|
_optlen: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function shutdown(_s: ULONG; _how: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function socket(_af, _struct, _protocol: Integer): ULONG; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
|
||||||
|
function gethostbyaddr(_addr: Pointer; _len, _struct: Integer): PHostEnt; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function gethostbyname(_name: PChar): PHostEnt; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function gethostname(_name: PChar; _len: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getservbyport(_port: Integer; _proto: PChar): PServEnt; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getservbyname(_name, _proto: PChar): PServEnt; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getprotobynumber(_proto: Integer): PProtoEnt; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function getprotobyname(_name: PChar): PProtoEnt; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
|
||||||
|
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSACleanup: Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
procedure WSASetLastError(iError: Integer); {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAGetLastError: Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAIsBlocking: BOOL; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAUnhookBlockingHook: Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSACancelBlockingCall: Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int;
|
||||||
|
name, proto, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int;
|
||||||
|
proto, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int;
|
||||||
|
name, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer;
|
||||||
|
buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;
|
||||||
|
name, buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar;
|
||||||
|
len, struct: Integer; buf: PChar; buflen: Integer): THandle; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSAAsyncSelect(s: ULONG; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
function WSARecvEx(s: ULONG; var buf; len: Integer; var flags: Integer): Integer; {$IFNDEF FPC} stdcall; {$ENDIF}
|
||||||
|
|
||||||
|
function WSAMakeSyncReply(Buflen, Error: Word): Longint;
|
||||||
|
function WSAMakeSelectReply(Event, Error: Word): Longint;
|
||||||
|
function WSAGetAsyncBuflen(Param: Longint): Word;
|
||||||
|
function WSAGetAsyncError(Param: Longint): Word;
|
||||||
|
function WSAGetSelectEvent(Param: Longint): Word;
|
||||||
|
function WSAGetSelectError(Param: Longint): Word;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
const
|
||||||
|
winsocket = 'wsock32.dll';
|
||||||
|
|
||||||
|
function WSAMakeSyncReply(Buflen, Error: Word): Longint;
|
||||||
|
begin
|
||||||
|
WSAMakeSyncReply:= MakeLong(Buflen, Error);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WSAMakeSelectReply(Event, Error: Word): Longint;
|
||||||
|
begin
|
||||||
|
WSAMakeSelectReply:= MakeLong(Event, Error);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WSAGetAsyncBuflen(Param: Longint): Word;
|
||||||
|
begin
|
||||||
|
WSAGetAsyncBuflen:= LOWORD(Param);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WSAGetAsyncError(Param: Longint): Word;
|
||||||
|
begin
|
||||||
|
WSAGetAsyncError:= HIWORD(Param);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WSAGetSelectEvent(Param: Longint): Word;
|
||||||
|
begin
|
||||||
|
WSAGetSelectEvent:= LOWORD(Param);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function WSAGetSelectError(Param: Longint): Word;
|
||||||
|
begin
|
||||||
|
WSAGetSelectError:= HIWORD(Param);
|
||||||
|
end;
|
||||||
|
|
||||||
|
function accept(_s: ULONG; _addr: pSockAddr; _addrlen: PInteger): ULONG; external winsocket name 'accept';
|
||||||
|
function bind(_s: ULONG; _addr: pSockAddr; _namelen: Integer): Integer; external winsocket name 'bind';
|
||||||
|
function connect(_s: ULONG; _name: pSockAddr; _namelen: Integer): Integer; external winsocket name 'connect';
|
||||||
|
function closesocket(s: ULONG): Integer; external winsocket name 'closesocket';
|
||||||
|
function select(nfds: Integer; readfds, writefds, exceptfds: PFDSet;
|
||||||
|
timeout: PTimeVal): Longint; external winsocket name 'select';
|
||||||
|
function ioctlsocket(_s: ULONG; _cmd: Longint; var _arg: ULONG): Integer; external winsocket name 'ioctlsocket';
|
||||||
|
function getpeername(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; external winsocket name 'getpeername';
|
||||||
|
function getsockname(_s: ULONG; _name: pSockAddr; var _namelen: Integer): Integer; external winsocket name 'getsockname';
|
||||||
|
function getsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar; var _optlen: Integer): Integer; external winsocket name 'getsockopt';
|
||||||
|
function htonl(_hostlong: ULONG): ULONG; external winsocket name 'htonl';
|
||||||
|
function htons(_hostshort: Integer): Integer; external winsocket name 'htons';
|
||||||
|
function inet_addr(_cp: PChar): ULONG; external winsocket name 'inet_addr';
|
||||||
|
function inet_ntoa(_inaddr: tIn_Addr): PChar; external winsocket name 'inet_ntoa';
|
||||||
|
function listen(_s: ULONG; _backlog: Integer): Integer; external winsocket name 'listen';
|
||||||
|
function ntohl(_netlong: ULONG): ULONG; external winsocket name 'ntohl';
|
||||||
|
function ntohs(_netshort: Integer): Integer; external winsocket name 'ntohs';
|
||||||
|
function recv(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; external winsocket name 'recv';
|
||||||
|
|
||||||
|
|
||||||
|
function recvfrom(s: ULONG; _Buf: pointer; _len, _flags: Integer;
|
||||||
|
var _from: TSockAddr; var _fromlen: Integer): Integer; external winsocket name 'recvfrom';
|
||||||
|
function send(_s: ULONG; _Buf: pointer; _len, _flags: Integer): Integer; external winsocket name 'send';
|
||||||
|
function sendto(_s: ULONG; _Buf: pointer; _len, _flags: Integer; var _addrto: TSockAddr;
|
||||||
|
_tolen: Integer): Integer; external winsocket name 'sendto';
|
||||||
|
function setsockopt(_s: ULONG; _level, _optname: Integer; _optval: PChar;
|
||||||
|
_optlen: Integer): Integer; external winsocket name 'setsockopt';
|
||||||
|
function shutdown(_s: ULONG; _how: Integer): Integer; external winsocket name 'shutdown';
|
||||||
|
function socket(_af, _struct, _protocol: Integer): ULONG; external winsocket name 'socket';
|
||||||
|
|
||||||
|
|
||||||
|
function gethostbyaddr(_addr: Pointer; _len, _struct: Integer): PHostEnt; external winsocket name 'gethostbyaddr';
|
||||||
|
function gethostbyname(_name: PChar): PHostEnt; external winsocket name 'gethostbyname';
|
||||||
|
function gethostname(_name: PChar; _len: Integer): Integer; external winsocket name 'gethostname';
|
||||||
|
function getservbyport(_port: Integer; _proto: PChar): PServEnt; external winsocket name 'getservbyport';
|
||||||
|
function getservbyname(_name, _proto: PChar): PServEnt; external winsocket name 'getservbyname';
|
||||||
|
function getprotobynumber(_proto: Integer): PProtoEnt; external winsocket name 'getprotobynumber';
|
||||||
|
function getprotobyname(_name: PChar): PProtoEnt; external winsocket name 'getprotobyname';
|
||||||
|
|
||||||
|
|
||||||
|
function WSAStartup(wVersionRequired: word; var WSData: TWSAData): Integer; external winsocket name 'WSAStartup';
|
||||||
|
function WSACleanup: Integer; external winsocket name 'WSACleanup';
|
||||||
|
procedure WSASetLastError(iError: Integer); external winsocket name 'WSASetLastError';
|
||||||
|
function WSAGetLastError: Integer; external winsocket name 'WSAGetLastError';
|
||||||
|
function WSAIsBlocking: BOOL; external winsocket name 'WSAIsBlocking';
|
||||||
|
function WSAUnhookBlockingHook: Integer; external winsocket name 'WSAUnhookBlockingHook';
|
||||||
|
function WSASetBlockingHook(lpBlockFunc: TFarProc): TFarProc; external winsocket name 'WSASetBlockingHook';
|
||||||
|
function WSACancelBlockingCall: Integer; external winsocket name 'WSACancelBlockingCall';
|
||||||
|
function WSAAsyncGetServByName(HWindow: HWND; wMsg: u_int;
|
||||||
|
name, proto, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetServByName';
|
||||||
|
function WSAAsyncGetServByPort( HWindow: HWND; wMsg, port: u_int;
|
||||||
|
proto, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetServByPort';
|
||||||
|
function WSAAsyncGetProtoByName(HWindow: HWND; wMsg: u_int;
|
||||||
|
name, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetProtoByName';
|
||||||
|
function WSAAsyncGetProtoByNumber(HWindow: HWND; wMsg: u_int; number: Integer;
|
||||||
|
buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetProtoByNumber';
|
||||||
|
function WSAAsyncGetHostByName(HWindow: HWND; wMsg: u_int;
|
||||||
|
name, buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetHostByName';
|
||||||
|
function WSAAsyncGetHostByAddr(HWindow: HWND; wMsg: u_int; addr: PChar;
|
||||||
|
len, struct: Integer; buf: PChar; buflen: Integer): THandle; external winsocket name 'WSAAsyncGetHostByAddr';
|
||||||
|
function WSACancelAsyncRequest(hAsyncTaskHandle: THandle): Integer; external winsocket name 'WSACancelAsyncRequest';
|
||||||
|
function WSAAsyncSelect(s: ULONG; HWindow: HWND; wMsg: u_int; lEvent: Longint): Integer; external winsocket name 'WSAAsyncSelect';
|
||||||
|
function WSARecvEx(s: ULONG; var buf; len: Integer; var flags: Integer): Integer; external winsocket name 'WSARecvEx';
|
||||||
|
|
||||||
|
end. { unit. W32SOCK }
|
|
@ -0,0 +1,790 @@
|
||||||
|
unit WIN32COM;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
|
||||||
|
** Tested with: TurboPascal v7.0, (DOS)
|
||||||
|
** VirtualPascal v2.0, (OS/2, Win32)
|
||||||
|
** FreePascal v0.99.15 (DOS, Win32)
|
||||||
|
** Delphi v4.0. (Win32)
|
||||||
|
**
|
||||||
|
** Version : 1.01
|
||||||
|
** Created : 21-May-1998
|
||||||
|
** Last update : 20-Feb-2000
|
||||||
|
**
|
||||||
|
** Note: (c) 1998-2000 by Maarten Bekers
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
This unit is not supported anymore.
|
||||||
|
Remove this in order to be compiled anyway. The next release of EleCOM will
|
||||||
|
not include WIN32COM.PAS anymore. W32SNGL.PAS is the replacement unit.
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
INTERFACE
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses Windows, Combase, BufUnit, Threads
|
||||||
|
{$IFDEF VirtualPascal}
|
||||||
|
,Use32
|
||||||
|
{$ENDIF};
|
||||||
|
|
||||||
|
Const WriteTimeout = 20000; { Wait max. 20 secs }
|
||||||
|
ReadTimeOut = 20000; { General event, 20 secs max }
|
||||||
|
|
||||||
|
InBufSize = 1024 * 32;
|
||||||
|
OutBufSize = 1024 * 32;
|
||||||
|
|
||||||
|
|
||||||
|
type TWin32Obj = Object(TCommObj)
|
||||||
|
ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
|
||||||
|
ThreadsInitted: Boolean; { Are the thread(s) up and running? }
|
||||||
|
|
||||||
|
SaveHandle : THandle;
|
||||||
|
|
||||||
|
InitPortNr : Longint;
|
||||||
|
InitHandle : Longint;
|
||||||
|
|
||||||
|
ReadOL : TOverLapped; { Overlapped structure for ReadFile }
|
||||||
|
WriteOL : TOverLapped; { Overlapped structure for WriteFile }
|
||||||
|
|
||||||
|
InBuffer : ^BufArrayObj; { Buffer system internally used }
|
||||||
|
OutBuffer : ^BufArrayObj;
|
||||||
|
|
||||||
|
ReadEvent : PSysEventObj; { Event set by ReadFile overlapped routine }
|
||||||
|
WriteEvent : PSysEventObj; { Event set by WriteFile overlapped routine }
|
||||||
|
RecvEvent : PSysEventObj;
|
||||||
|
|
||||||
|
DoTxEvent : PSysEventObj;{ Event manually set when we have to transmit }
|
||||||
|
|
||||||
|
TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed }
|
||||||
|
RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed }
|
||||||
|
|
||||||
|
CriticalTx : PExclusiveObj; { Critical sections }
|
||||||
|
CriticalRx : PExclusiveObj;
|
||||||
|
|
||||||
|
TxThread : PThreadsObj; { The Transmit and Receive threads }
|
||||||
|
RxThread : PThreadsObj;
|
||||||
|
|
||||||
|
EndThreads : Boolean; { Set to true when we have to end the threads }
|
||||||
|
|
||||||
|
constructor Init;
|
||||||
|
destructor Done;
|
||||||
|
|
||||||
|
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean; virtual;
|
||||||
|
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
|
||||||
|
function Com_GetChar: Char; virtual;
|
||||||
|
function Com_CharAvail: Boolean; virtual;
|
||||||
|
function Com_Carrier: Boolean; virtual;
|
||||||
|
function Com_SendChar(C: Char): Boolean; virtual;
|
||||||
|
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
|
||||||
|
function Com_GetBPSrate: Longint; virtual;
|
||||||
|
function Com_GetHandle: Longint; virtual;
|
||||||
|
|
||||||
|
procedure Com_OpenQuick(Handle: Longint); virtual;
|
||||||
|
procedure Com_Close; virtual;
|
||||||
|
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
|
||||||
|
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
|
||||||
|
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
|
||||||
|
procedure Com_SetDtr(State: Boolean); virtual;
|
||||||
|
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
|
||||||
|
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
|
||||||
|
procedure Com_PurgeInBuffer; virtual;
|
||||||
|
procedure Com_PurgeOutBuffer; virtual;
|
||||||
|
|
||||||
|
procedure Com_PauseCom(CloseCom: Boolean); virtual;
|
||||||
|
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
|
||||||
|
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
|
||||||
|
|
||||||
|
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
|
||||||
|
|
||||||
|
procedure Com_ReadProc(var TempPtr: Pointer);
|
||||||
|
procedure Com_WriteProc(var TempPtr: Pointer);
|
||||||
|
|
||||||
|
function Com_StartThread: Boolean;
|
||||||
|
procedure Com_InitVars;
|
||||||
|
procedure Com_StopThread;
|
||||||
|
procedure Com_InitDelayTimes;
|
||||||
|
end; { object TWin32Obj }
|
||||||
|
|
||||||
|
type PWin32Obj = ^TWin32Obj;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
IMPLEMENTATION
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
uses SysUtils;
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
{$I WINDEF.FPC}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
const
|
||||||
|
dcb_Binary = $00000001;
|
||||||
|
dcb_ParityCheck = $00000002;
|
||||||
|
dcb_OutxCtsFlow = $00000004;
|
||||||
|
dcb_OutxDsrFlow = $00000008;
|
||||||
|
dcb_DtrControlMask = $00000030;
|
||||||
|
dcb_DtrControlDisable = $00000000;
|
||||||
|
dcb_DtrControlEnable = $00000010;
|
||||||
|
dcb_DtrControlHandshake = $00000020;
|
||||||
|
dcb_DsrSensivity = $00000040;
|
||||||
|
dcb_TXContinueOnXoff = $00000080;
|
||||||
|
dcb_OutX = $00000100;
|
||||||
|
dcb_InX = $00000200;
|
||||||
|
dcb_ErrorChar = $00000400;
|
||||||
|
dcb_NullStrip = $00000800;
|
||||||
|
dcb_RtsControlMask = $00003000;
|
||||||
|
dcb_RtsControlDisable = $00000000;
|
||||||
|
dcb_RtsControlEnable = $00001000;
|
||||||
|
dcb_RtsControlHandshake = $00002000;
|
||||||
|
dcb_RtsControlToggle = $00003000;
|
||||||
|
dcb_AbortOnError = $00004000;
|
||||||
|
dcb_Reserveds = $FFFF8000;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
constructor TWin32Obj.Init;
|
||||||
|
begin
|
||||||
|
inherited Init;
|
||||||
|
|
||||||
|
InitPortNr := -1;
|
||||||
|
InitHandle := -1;
|
||||||
|
ThreadsInitted := false;
|
||||||
|
Com_InitVars;
|
||||||
|
end; { constructor Init }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
destructor TWin32Obj.Done;
|
||||||
|
begin
|
||||||
|
inherited done;
|
||||||
|
end; { destructor Done }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_ReadProc(var TempPtr: Pointer);
|
||||||
|
var EventMask : DWORD;
|
||||||
|
Success : Boolean;
|
||||||
|
Props : TCommProp;
|
||||||
|
ReturnCode: Longint;
|
||||||
|
DidRead : DWORD;
|
||||||
|
BlockLen : Longint;
|
||||||
|
|
||||||
|
RecvOL : tOverlapped;
|
||||||
|
begin
|
||||||
|
New(RecvEvent, Init);
|
||||||
|
if NOT RecvEvent^.CreateEvent(true) then EXIT;
|
||||||
|
|
||||||
|
FillChar(RecvOL, SizeOf(tOverLapped), 0);
|
||||||
|
RecvOL.hEvent := RecvEvent^.SemHandle;
|
||||||
|
|
||||||
|
EventMask := EV_RXCHAR;
|
||||||
|
SetCommMask(SaveHandle, EventMask); { Signal us if anything is received }
|
||||||
|
|
||||||
|
repeat
|
||||||
|
WaitCommEvent(SaveHandle, EventMask, @RecvOL);
|
||||||
|
if EndThreads then EXIT;
|
||||||
|
|
||||||
|
repeat
|
||||||
|
ReturnCode := WaitForSingleObject(RecvOL.hEvent, 500);
|
||||||
|
if ReturnCode = WAIT_OBJECT_0 then
|
||||||
|
begin
|
||||||
|
Success := true
|
||||||
|
end { if }
|
||||||
|
else Success := false;
|
||||||
|
|
||||||
|
if EndThreads then BREAK;
|
||||||
|
until (Success);
|
||||||
|
|
||||||
|
DidRead := 00;
|
||||||
|
|
||||||
|
if (NOT Success) OR (EventMask = 0) then EXIT;
|
||||||
|
if (EndThreads) then EXIT;
|
||||||
|
|
||||||
|
{----------------- Start reading the gathered date ---------------------}
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
|
||||||
|
FillChar(Props, SizeOf(TCommProp), 0);
|
||||||
|
|
||||||
|
if GetCommProperties(SaveHandle, Props) then
|
||||||
|
if InBuffer^.BufRoom > 0 then
|
||||||
|
begin
|
||||||
|
BlockLen := Props.dwCurrentRxQueue;
|
||||||
|
|
||||||
|
if BlockLen > InBuffer^.BufRoom then
|
||||||
|
BlockLen := InBuffer^.BufRoom;
|
||||||
|
|
||||||
|
Success := ReadFile(SaveHandle,
|
||||||
|
InBuffer^.TmpBuf^,
|
||||||
|
BlockLen,
|
||||||
|
DidRead,
|
||||||
|
@ReadOL);
|
||||||
|
|
||||||
|
if NOT Success then
|
||||||
|
begin
|
||||||
|
ReturnCode := GetLastError;
|
||||||
|
|
||||||
|
if ReturnCode = ERROR_IO_PENDING then
|
||||||
|
begin
|
||||||
|
ReturnCode := WaitForSingleObject(ReadOL.hEvent, ReadTimeOut);
|
||||||
|
|
||||||
|
if ReturnCode = WAIT_OBJECT_0 then
|
||||||
|
begin
|
||||||
|
GetOverLappedResult(SaveHandle, ReadOL, DidRead, false);
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end
|
||||||
|
else GetOverlappedResult(SaveHandle, ReadOL, DidRead, false);
|
||||||
|
|
||||||
|
if DidRead > 00 then
|
||||||
|
InBuffer^.Put(InBuffer^.TmpBuf^, DidRead);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
RxClosedEvent^.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. ComReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_WriteProc(var TempPtr: Pointer);
|
||||||
|
var BlockLen : Longint;
|
||||||
|
Written : DWORD;
|
||||||
|
ReturnCode: Longint;
|
||||||
|
Success : Boolean;
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
if DoTxEvent^.WaitForEvent(WriteTimeOut) then
|
||||||
|
if NOT EndThreads then
|
||||||
|
begin
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
DoTxEvent^.ResetEvent;
|
||||||
|
|
||||||
|
if OutBuffer^.BufUsed > 00 then
|
||||||
|
begin
|
||||||
|
Written := 00;
|
||||||
|
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf^, OutBuffer^.BufUsed, false);
|
||||||
|
|
||||||
|
Success := WriteFile(SaveHandle,
|
||||||
|
OutBuffer^.TmpBuf^,
|
||||||
|
BlockLen,
|
||||||
|
Written,
|
||||||
|
@WriteOL);
|
||||||
|
if NOT Success then
|
||||||
|
begin
|
||||||
|
ReturnCode := GetLastError;
|
||||||
|
|
||||||
|
if ReturnCode = ERROR_IO_PENDING then
|
||||||
|
begin
|
||||||
|
ReturnCode := WaitForSingleObject(WriteOL.hEvent, WriteTimeOut);
|
||||||
|
|
||||||
|
if ReturnCode = WAIT_OBJECT_0 then
|
||||||
|
begin
|
||||||
|
if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
|
||||||
|
begin
|
||||||
|
ResetEvent(WriteOL.hEvent);
|
||||||
|
end; { if }
|
||||||
|
end; { if }
|
||||||
|
end; { result is pending }
|
||||||
|
end { if }
|
||||||
|
else begin
|
||||||
|
|
||||||
|
if GetOverLappedResult(SaveHandle, WriteOL, Written, false) then
|
||||||
|
begin
|
||||||
|
ResetEvent(WriteOL.hEvent);
|
||||||
|
end; { if }
|
||||||
|
end; { if (did succeed) }
|
||||||
|
|
||||||
|
ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf^, Written, true);
|
||||||
|
if Written <> BlockLen then
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
until EndThreads;
|
||||||
|
|
||||||
|
TxClosedEvent^.SignalEvent;
|
||||||
|
ExitThisThread;
|
||||||
|
end; { proc. ComWriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_StartThread: Boolean;
|
||||||
|
begin
|
||||||
|
Result := false;
|
||||||
|
EndThreads := false;
|
||||||
|
if ThreadsInitted then EXIT;
|
||||||
|
ThreadsInitted := true;
|
||||||
|
|
||||||
|
{----------------------- Create all the events ----------------------------}
|
||||||
|
New(ReadEvent, Init);
|
||||||
|
if NOT ReadEvent^.CreateEvent(true) then EXIT;
|
||||||
|
|
||||||
|
New(WriteEvent, Init);
|
||||||
|
if NOT WriteEvent^.CreateEvent(true) then EXIT;
|
||||||
|
|
||||||
|
New(DoTxEvent, Init);
|
||||||
|
if NOT DoTxEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(RxClosedEvent, Init);
|
||||||
|
if NOT RxClosedEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
New(TxClosedEvent, Init);
|
||||||
|
if NOT TxClosedEvent^.CreateEvent(false) then EXIT;
|
||||||
|
|
||||||
|
{-------------- Startup the buffers and overlapped events -----------------}
|
||||||
|
FillChar(WriteOL, SizeOf(tOverLapped), 0);
|
||||||
|
FillChar(ReadOL, SizeOf(tOverLapped), 0);
|
||||||
|
WriteOl.hEvent := WriteEvent^.SemHandle;
|
||||||
|
ReadOl.hEvent := ReadEvent^.SemHandle;
|
||||||
|
|
||||||
|
New(InBuffer, Init(InBufSize));
|
||||||
|
New(OutBuffer, Init(OutBufSize));
|
||||||
|
|
||||||
|
if (InBuffer^.TxtArr=nil) OR (InBuffer^.TmpBuf=nil) then EXIT;
|
||||||
|
if (OutBuffer^.TxtArr=nil) OR (OutBuffer^.TmpBuf=nil) then EXIT;
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate write thread ---------------------}
|
||||||
|
New(CriticalTx, Init);
|
||||||
|
CriticalTx^.CreateExclusive;
|
||||||
|
|
||||||
|
New(TxThread, Init);
|
||||||
|
if NOT TxThread^.CreateThread(16384, { Stack size }
|
||||||
|
@WriteProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
{-------------------- Startup a seperate read thread ----------------------}
|
||||||
|
New(CriticalRx, Init);
|
||||||
|
CriticalRx^.CreateExclusive;
|
||||||
|
|
||||||
|
New(RxThread, Init);
|
||||||
|
if NOT RxThread^.CreateThread(16384, { Stack size }
|
||||||
|
@ReadProcPtr, { Actual procedure }
|
||||||
|
nil, { Parameters }
|
||||||
|
0) { Creation flags }
|
||||||
|
then EXIT;
|
||||||
|
|
||||||
|
Result := true;
|
||||||
|
end; { proc. Com_StartThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_InitVars;
|
||||||
|
begin
|
||||||
|
DoTxEvent := nil;
|
||||||
|
RxClosedEvent := nil;
|
||||||
|
TxClosedEvent := nil;
|
||||||
|
RecvEvent := nil;
|
||||||
|
ReadEvent := nil;
|
||||||
|
WriteEvent := nil;
|
||||||
|
TxThread := nil;
|
||||||
|
RxThread := nil;
|
||||||
|
|
||||||
|
InBuffer := nil;
|
||||||
|
OutBuffer := nil;
|
||||||
|
CriticalRx := nil;
|
||||||
|
CriticalTx := nil;
|
||||||
|
end; { proc. Com_InitVars }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_StopThread;
|
||||||
|
begin
|
||||||
|
EndThreads := true;
|
||||||
|
ThreadsInitted := false;
|
||||||
|
|
||||||
|
if DoTxEvent <> nil then DoTxEvent^.SignalEvent;
|
||||||
|
|
||||||
|
if TxThread <> nil then TxThread^.CloseThread;
|
||||||
|
if RxThread <> nil then RxThread^.CloseThread;
|
||||||
|
|
||||||
|
if TxClosedEvent <> nil then
|
||||||
|
if NOT TxClosedEvent^.WaitForEvent(1000) then
|
||||||
|
TxThread^.TerminateThread(0);
|
||||||
|
|
||||||
|
if RxClosedEvent <> nil then
|
||||||
|
if NOT RxClosedEvent^.WaitForEvent(1000) then
|
||||||
|
RxThread^.TerminateThread(0);
|
||||||
|
|
||||||
|
if TxThread <> nil then Dispose(TxThread, Done);
|
||||||
|
if RxThread <> nil then Dispose(RxThread, Done);
|
||||||
|
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
|
||||||
|
if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
|
||||||
|
if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done);
|
||||||
|
|
||||||
|
if CriticalTx <> nil then Dispose(CriticalTx, Done);
|
||||||
|
if CriticalRx <> nil then Dispose(CriticalRx, Done);
|
||||||
|
|
||||||
|
if InBuffer <> nil then Dispose(InBuffer, Done);
|
||||||
|
if OutBuffer <> nil then Dispose(OutBuffer, Done);
|
||||||
|
|
||||||
|
if RecvEvent <> nil then Dispose(RecvEvent, Done);
|
||||||
|
if ReadEvent <> nil then Dispose(ReadEvent, Done);
|
||||||
|
if WriteEvent <> nil then Dispose(WriteEvent, Done);
|
||||||
|
|
||||||
|
Com_InitVars;
|
||||||
|
end; { proc. Com_StopThread }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_InitDelayTimes;
|
||||||
|
var CommTimeOut: TCommTimeouts;
|
||||||
|
RC : Longint;
|
||||||
|
begin
|
||||||
|
FillChar(CommTimeOut, SizeOf(TCommTimeOuts), 00);
|
||||||
|
CommTimeOut.ReadIntervalTimeout := MAXDWORD;
|
||||||
|
|
||||||
|
if NOT SetCommTimeOuts(SaveHandle, CommTimeOut) then
|
||||||
|
begin
|
||||||
|
RC := GetLastError;
|
||||||
|
{ ErrorStr := 'Error setting communications timeout: #'+IntToStr(RC) + ' / ' + SysErrorMessage(rc)); }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
end; { proc. InitDelayTimes }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_GetHandle: Longint;
|
||||||
|
begin
|
||||||
|
Result := SaveHandle;
|
||||||
|
end; { func. Com_GetHandle }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_OpenQuick(Handle: Longint);
|
||||||
|
var LastError: Longint;
|
||||||
|
begin
|
||||||
|
SaveHandle := Handle;
|
||||||
|
InitHandle := Handle;
|
||||||
|
|
||||||
|
FillChar(ReadOl, SizeOf(ReadOl), 00);
|
||||||
|
FillChar(WriteOl, SizeOf(WriteOl), 00);
|
||||||
|
|
||||||
|
Com_InitDelayTimes;
|
||||||
|
|
||||||
|
if NOT SetupComm(Com_GetHandle, 1024, 1024) then
|
||||||
|
begin
|
||||||
|
LastError := GetLastError;
|
||||||
|
|
||||||
|
{ ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
Com_SetLine(-1, 'N', 8, 1);
|
||||||
|
end; { proc. TWin32Obj.Com_OpenQuick }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_OpenKeep(Comport: Byte): Boolean;
|
||||||
|
var TempSave : THandle;
|
||||||
|
Security : TSECURITYATTRIBUTES;
|
||||||
|
LastError : Longint;
|
||||||
|
begin
|
||||||
|
InitPortNr := Comport;
|
||||||
|
|
||||||
|
FillChar(ReadOl, SizeOf(ReadOl), 00);
|
||||||
|
FillChar(WriteOl, SizeOf(WriteOl), 00);
|
||||||
|
|
||||||
|
FillChar(Security, SizeOf(TSECURITYATTRIBUTES), 0);
|
||||||
|
Security.nLength := SizeOf(TSECURITYATTRIBUTES);
|
||||||
|
Security.lpSecurityDescriptor := nil;
|
||||||
|
Security.bInheritHandle := true;
|
||||||
|
|
||||||
|
TempSave := CreateFile(PChar('\\.\COM' + IntToStr(ComPort)),
|
||||||
|
GENERIC_READ or GENERIC_WRITE,
|
||||||
|
0,
|
||||||
|
@Security, { No Security }
|
||||||
|
OPEN_EXISTING, { Creation action }
|
||||||
|
FILE_ATTRIBUTE_NORMAL or FILE_FLAG_OVERLAPPED,
|
||||||
|
0); { No template }
|
||||||
|
LastError := GetLastError;
|
||||||
|
if LastError <> 0 then
|
||||||
|
ErrorStr := 'Unable to open communications port';
|
||||||
|
|
||||||
|
SaveHandle := TempSave;
|
||||||
|
Result := (TempSave <> INVALID_HANDLE_VALUE);
|
||||||
|
|
||||||
|
if Result then { Make sure that "CharAvail" isn't going to wait }
|
||||||
|
begin
|
||||||
|
Com_InitDelayTimes;
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
if NOT SetupComm(Com_GetHandle, 1024, 1024) then
|
||||||
|
begin
|
||||||
|
LastError := GetLastError;
|
||||||
|
|
||||||
|
{ ErrorStr := 'Error setting up communications buffer: #'+IntToStr(LastError) + ' / '+SysErrorMessage(LastError); }
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
InitFailed := NOT Com_StartThread;
|
||||||
|
end; { func. Com_OpenKeep }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
|
||||||
|
Parity: Char; StopBits: Byte): Boolean;
|
||||||
|
begin
|
||||||
|
Com_Open := Com_OpenKeep(Comport);
|
||||||
|
Com_SetLine(Baudrate, Parity, DataBits, StopBits);
|
||||||
|
end; { func. TWin32Obj.Com_OpenCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
|
||||||
|
var DCB : TDCB;
|
||||||
|
BPSID : Longint;
|
||||||
|
begin
|
||||||
|
if BpsRate = 11520 then
|
||||||
|
BpsRate := 115200;
|
||||||
|
|
||||||
|
GetCommState(Com_GetHandle, DCB);
|
||||||
|
|
||||||
|
if NOT (Parity in ['N', 'E', 'O', 'M']) then Parity := 'N';
|
||||||
|
if BpsRate >= 0 then dcb.BaudRate := BpsRate;
|
||||||
|
dcb.StopBits := ONESTOPBIT;
|
||||||
|
|
||||||
|
Case Parity of
|
||||||
|
'N' : dcb.Parity := NOPARITY;
|
||||||
|
'E' : dcb.Parity := EVENPARITY;
|
||||||
|
'O' : dcb.Parity := ODDPARITY;
|
||||||
|
'M' : dcb.Parity := MARKPARITY;
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
if StopBits = 1 then
|
||||||
|
dcb.StopBits := ONESTOPBIT;
|
||||||
|
dcb.ByteSize := DataBits;
|
||||||
|
dcb.Flags := dcb.Flags OR dcb_Binary or Dcb_DtrControlEnable;
|
||||||
|
|
||||||
|
if not SetCommState (Com_GetHandle, DCB) then
|
||||||
|
begin
|
||||||
|
BPSId := GetLastError;
|
||||||
|
|
||||||
|
{ ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); }
|
||||||
|
end; { if }
|
||||||
|
end; { proc. TWin32Obj.Com_SetLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_Close;
|
||||||
|
begin
|
||||||
|
if DontClose then EXIT;
|
||||||
|
|
||||||
|
if Com_GetHandle <> INVALID_HANDLE_VALUE then
|
||||||
|
begin
|
||||||
|
Com_StopThread;
|
||||||
|
CloseHandle(Com_GetHandle);
|
||||||
|
|
||||||
|
SaveHandle := INVALID_HANDLE_VALUE;
|
||||||
|
end;
|
||||||
|
|
||||||
|
end; { func. TWin32Obj.Com_CloseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_SendChar(C: Char): Boolean;
|
||||||
|
var Written: Longint;
|
||||||
|
begin
|
||||||
|
Com_SendBlock(C, SizeOf(C), Written);
|
||||||
|
Com_SendChar := (Written = SizeOf(c));
|
||||||
|
end; { proc. TWin32Obj.Com_SendChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_GetChar: Char;
|
||||||
|
var Reads: Longint;
|
||||||
|
begin
|
||||||
|
Com_ReadBlock(Result, SizeOf(Result), Reads);
|
||||||
|
end; { func. TWin32Obj.Com_GetChar }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
|
||||||
|
begin
|
||||||
|
if OutBuffer^.BufRoom < BlockLen then
|
||||||
|
repeat
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Sleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
DosSleep(1);
|
||||||
|
{$ENDIF}
|
||||||
|
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
Written := OutBuffer^.Put(Block, BlockLen);
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
|
||||||
|
DoTxEvent^.SignalEvent;
|
||||||
|
end; { proc. TWin32Obj.Com_SendBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
|
||||||
|
begin
|
||||||
|
if InBuffer^.BufUsed < BlockLen then
|
||||||
|
begin
|
||||||
|
repeat
|
||||||
|
Sleep(1);
|
||||||
|
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
|
||||||
|
end; { if }
|
||||||
|
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
Reads := InBuffer^.Get(Block, BlockLen, true);
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { proc. TWin32Obj.Com_ReadBlock }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_CharAvail: Boolean;
|
||||||
|
begin
|
||||||
|
Result := (InBuffer^.BufUsed > 0);
|
||||||
|
end; { func. TWin32Obj.Com_CharAvail }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_Carrier: Boolean;
|
||||||
|
var Status: DWORD;
|
||||||
|
begin
|
||||||
|
GetCommModemStatus(Com_GetHandle,
|
||||||
|
Status);
|
||||||
|
|
||||||
|
Result := (Status AND MS_RLSD_ON) <> 00;
|
||||||
|
end; { func. TWin32Obj.Com_Carrier }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
|
||||||
|
var Data: DWORD;
|
||||||
|
begin
|
||||||
|
GetCommModemStatus(Com_GetHandle, Data);
|
||||||
|
|
||||||
|
ModemStatus := ModemStatus and $0F;
|
||||||
|
ModemStatus := ModemStatus or Byte(Data);
|
||||||
|
end; { proc. TWin32Obj.Com_GetModemStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetDtr(State: Boolean);
|
||||||
|
begin
|
||||||
|
if State then
|
||||||
|
EscapeCommFunction(Com_GetHandle, SETDTR)
|
||||||
|
else EscapeCommFunction(Com_GetHandle, CLRDTR);
|
||||||
|
end; { proc. TWin32Obj.Com_SetDtr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_GetBpsRate: Longint;
|
||||||
|
var DCB : TDCB;
|
||||||
|
BPSID : Longint;
|
||||||
|
begin
|
||||||
|
GetCommState(Com_GetHandle, DCB);
|
||||||
|
|
||||||
|
Com_GetBpsRate := dcb.Baudrate;
|
||||||
|
end; { func. TWin32Obj.Com_GetBpsRate }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
|
||||||
|
begin
|
||||||
|
InFree := InBuffer^.BufRoom;
|
||||||
|
OutFree := OutBuffer^.BufRoom;
|
||||||
|
InUsed := InBuffer^.BufUsed;
|
||||||
|
OutUsed := OutBuffer^.BufUsed;
|
||||||
|
end; { proc. TWin32Obj.Com_GetBufferStatus }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_PurgeInBuffer;
|
||||||
|
begin
|
||||||
|
CriticalRx^.EnterExclusive;
|
||||||
|
|
||||||
|
InBuffer^.Clear;
|
||||||
|
PurgeComm(Com_GetHandle, PURGE_RXCLEAR);
|
||||||
|
|
||||||
|
CriticalRx^.LeaveExclusive;
|
||||||
|
end; { proc. TWin32Obj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_PurgeOutBuffer;
|
||||||
|
begin
|
||||||
|
CriticalTx^.EnterExclusive;
|
||||||
|
|
||||||
|
OutBuffer^.Clear;
|
||||||
|
PurgeComm(Com_GetHandle, PURGE_TXCLEAR);
|
||||||
|
|
||||||
|
CriticalTx^.LeaveExclusive;
|
||||||
|
end; { proc. TWin32Obj.Com_PurgeInBuffer }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
function TWin32Obj.Com_ReadyToSend(BlockLen: Longint): Boolean;
|
||||||
|
begin
|
||||||
|
Result := OutBuffer^.BufRoom >= BlockLen;
|
||||||
|
end; { func. ReadyToSend }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_PauseCom(CloseCom: Boolean);
|
||||||
|
begin
|
||||||
|
if CloseCom then Com_Close
|
||||||
|
else Com_StopThread;
|
||||||
|
end; { proc. Com_PauseCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_ResumeCom(OpenCom: Boolean);
|
||||||
|
begin
|
||||||
|
if OpenCom then
|
||||||
|
begin
|
||||||
|
if InitPortNr <> -1 then Com_OpenKeep(InitPortNr)
|
||||||
|
else Com_OpenQuick(InitHandle);
|
||||||
|
end
|
||||||
|
else InitFailed := NOT Com_StartThread;
|
||||||
|
end; { proc. Com_ResumeCom }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
|
||||||
|
var DCB : TDCB;
|
||||||
|
BPSID : Longint;
|
||||||
|
begin
|
||||||
|
GetCommState(Com_GetHandle, DCB);
|
||||||
|
|
||||||
|
if Hard then
|
||||||
|
dcb.Flags := dcb.Flags OR dcb_OutxCtsFlow OR dcb_RtsControlHandshake;
|
||||||
|
|
||||||
|
if SoftTX then
|
||||||
|
dcb.Flags := dcb.Flags OR dcb_OutX;
|
||||||
|
|
||||||
|
if SoftRX then
|
||||||
|
dcb.Flags := dcb.Flags OR dcb_InX;
|
||||||
|
|
||||||
|
if not SetCommState (Com_GetHandle, DCB) then
|
||||||
|
begin
|
||||||
|
BPSId := GetLastError;
|
||||||
|
|
||||||
|
{ ErrorStr := 'Error setting up communications parameters: #'+IntToStr(BpsId) + ' / '+SysErrorMessage(BpsId); }
|
||||||
|
end; { if }
|
||||||
|
end; { proc. Com_SetFlow }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure TWin32Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
|
||||||
|
begin
|
||||||
|
ReadProcPtr := ReadPtr;
|
||||||
|
WriteProcPtr := WritePtr;
|
||||||
|
end; { proc. Com_SetDataProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
end.
|
|
@ -0,0 +1,79 @@
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Include file to make FPC more Delphi compatible
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
{$IFDEF FPC}
|
||||||
|
type DCB = record
|
||||||
|
DCBlength : DWORD;
|
||||||
|
BaudRate : DWORD;
|
||||||
|
flags : longint;
|
||||||
|
wReserved : WORD;
|
||||||
|
XonLim : WORD;
|
||||||
|
XoffLim : WORD;
|
||||||
|
ByteSize : BYTE;
|
||||||
|
Parity : BYTE;
|
||||||
|
StopBits : BYTE;
|
||||||
|
XonChar : char;
|
||||||
|
XoffChar : char;
|
||||||
|
ErrorChar : char;
|
||||||
|
EofChar : char;
|
||||||
|
EvtChar : char;
|
||||||
|
wReserved1 : WORD;
|
||||||
|
end;
|
||||||
|
|
||||||
|
TDcb = DCB;
|
||||||
|
pInteger = ^Integer;
|
||||||
|
|
||||||
|
PSecurityAttributes = ^TSecurityAttributes;
|
||||||
|
TSecurityAttributes = record
|
||||||
|
nLength: Longint;
|
||||||
|
lpSecurityDescriptor: Pointer;
|
||||||
|
bInheritHandle: Bool;
|
||||||
|
end;
|
||||||
|
|
||||||
|
function GetCommState(hFile:HANDLE; var lpDCB:TDCB):WINBOOL; external 'kernel32' name 'GetCommState';
|
||||||
|
function SetCommState(hFile:HANDLE; var lpDCB:TDCB):WINBOOL; external 'kernel32' name 'SetCommState';
|
||||||
|
function WaitForMultipleObjects(nCount:DWORD; lpHandles:Pointer; bWaitAll:WINBOOL; dwMilliseconds:DWORD):DWORD; external 'kernel32' name 'WaitForMultipleObjects';
|
||||||
|
|
||||||
|
|
||||||
|
{-- Apparently, FPC 1.0 doesnt have the "SysErrorMessage" defined in its ------}
|
||||||
|
{-- SYSUTILS unit. We create this function here. ------------------------------}
|
||||||
|
function FormatMessageA(dwFlags : DWORD;
|
||||||
|
lpSource : Pointer;
|
||||||
|
dwMessageId : DWORD;
|
||||||
|
dwLanguageId: DWORD;
|
||||||
|
lpBuffer : PCHAR;
|
||||||
|
nSize : DWORD;
|
||||||
|
Arguments : Pointer): DWORD; external 'kernel32' name 'FormatMessageA';
|
||||||
|
|
||||||
|
|
||||||
|
function SysErrorMessage(ErrorCode: Integer): String;
|
||||||
|
const
|
||||||
|
MaxMsgSize = Format_Message_Max_Width_Mask;
|
||||||
|
|
||||||
|
var MsgBuffer: pChar;
|
||||||
|
begin
|
||||||
|
{-- Allocate memory for error message ---------------------------------------}
|
||||||
|
GetMem(MsgBuffer, MaxMsgSize);
|
||||||
|
FillChar(MsgBuffer^, MaxMsgSize, #0);
|
||||||
|
|
||||||
|
{-- Retrieve the message ----------------------------------------------------}
|
||||||
|
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM,
|
||||||
|
nil,
|
||||||
|
ErrorCode,
|
||||||
|
MakeLangId(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||||
|
MsgBuffer, { This function allocs the memory }
|
||||||
|
MaxMsgSize, { Maximum message size }
|
||||||
|
nil);
|
||||||
|
|
||||||
|
{-- Return the string and release the memory --------------------------------}
|
||||||
|
SysErrorMessage := StrPas(MsgBuffer);
|
||||||
|
|
||||||
|
FreeMem(MsgBuffer, MaxMsgSize);
|
||||||
|
end; { func. SysErrorMessage }
|
||||||
|
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,86 @@
|
||||||
|
program DLLEXAM;
|
||||||
|
{$H-} { important, turn off Ansi-Strings }
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** Example how to use communications with the DLL file
|
||||||
|
** You can install this program from within EleBBS and test how it works :)
|
||||||
|
**
|
||||||
|
** version: 1.02
|
||||||
|
** Created: 13-Jun-1999
|
||||||
|
**
|
||||||
|
** EleBBS install lines:
|
||||||
|
**
|
||||||
|
** DOS install line: DLLEXAM.EXE -H*P
|
||||||
|
** Win32 install line: DLLEXAM.EXE -H*W
|
||||||
|
** Win32 (telnet) install line: DLLEXAM.EXE -H*W -XT
|
||||||
|
** OS/2 install line: DLLEXAM.EXE -H*W
|
||||||
|
** OS/2 (telnet) install line: DLLEXAM.EXE -H*W -XT
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
uses EleDEF;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
var IsTelnet : Boolean;
|
||||||
|
ComHandle : Longint;
|
||||||
|
ReadCH : Char;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure ParseCommandLine;
|
||||||
|
var Counter: Longint;
|
||||||
|
TempStr: String;
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Code : Integer;
|
||||||
|
{$ELSE}
|
||||||
|
Code : Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
for Counter := 01 to ParamCount do
|
||||||
|
begin
|
||||||
|
TempStr := ParamStr(Counter);
|
||||||
|
|
||||||
|
if TempStr[1] in ['/', '-'] then
|
||||||
|
Case UpCase(TempStr[2]) of
|
||||||
|
'H' : begin
|
||||||
|
|
||||||
|
TempStr := Copy(TempStr, 3, Length(TempStr) - 2);
|
||||||
|
Val(TempStr, ComHandle, Code);
|
||||||
|
|
||||||
|
|
||||||
|
end; { 'H' }
|
||||||
|
'X' : begin
|
||||||
|
|
||||||
|
if UpCase(TempStr[3]) = 'T' then { XT }
|
||||||
|
IsTelnet := true;
|
||||||
|
|
||||||
|
end; { 'X' }
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
end; { for }
|
||||||
|
end; { proc. ParseCommandLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
begin
|
||||||
|
IsTelnet := false;
|
||||||
|
ParseCommandLine;
|
||||||
|
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : Com_StartUp(1);
|
||||||
|
TRUE : Com_StartUp(2);
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
Com_SetDontClose(true); { We use an inherited handle, never close it! }
|
||||||
|
Com_OpenQuick(ComHandle); { Open the comport using the handle }
|
||||||
|
|
||||||
|
Com_SendString('Hello there!' + #13#10);
|
||||||
|
Com_SendString('Press [ENTER]');
|
||||||
|
|
||||||
|
repeat
|
||||||
|
ReadCH := Com_GetChar;
|
||||||
|
until (ReadCH = #13) OR (NOT Com_Carrier);
|
||||||
|
|
||||||
|
Com_ShutDown;
|
||||||
|
end.
|
|
@ -0,0 +1,181 @@
|
||||||
|
program Example;
|
||||||
|
(*
|
||||||
|
**
|
||||||
|
** EXAMPLE how to use communications
|
||||||
|
** You can install this program from within EleBBS and test how it works :)
|
||||||
|
** This is only an example of how to use EleCOM for writing so-called "doors",
|
||||||
|
** to see an example how to use EleCOM independent off a BBS program, see
|
||||||
|
** EXAM2.PAS
|
||||||
|
**
|
||||||
|
** version: 1.01
|
||||||
|
** Created: 08-Apr-1999
|
||||||
|
**
|
||||||
|
** EleBBS install lines:
|
||||||
|
**
|
||||||
|
** DOS install line: EXAMPLE.EXE -H*P
|
||||||
|
** Win32 install line: EXAMPLE.EXE -H*W
|
||||||
|
** Win32 (telnet) install line: EXAMPLE.EXE -H*W -XT
|
||||||
|
** OS/2 install line: EXAMPLE.EXE -H*W
|
||||||
|
** OS/2 (telnet) install line: EXAMPLE.EXE -H*W -XT
|
||||||
|
**
|
||||||
|
*)
|
||||||
|
|
||||||
|
{.DEFINE FOSSIL}
|
||||||
|
{.DEFINE OS2COM}
|
||||||
|
{$DEFINE W32COM}
|
||||||
|
|
||||||
|
{$IFNDEF FOSSIL}
|
||||||
|
{$IFNDEF OS2COM}
|
||||||
|
{$IFNDEF W32COM}
|
||||||
|
You need to define one of these..
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
uses Combase,
|
||||||
|
{$IFDEF FOSSIL}
|
||||||
|
Fos_Com
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2COM}
|
||||||
|
Os2Com,
|
||||||
|
Telnet
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF W32COM}
|
||||||
|
W32SNGL,
|
||||||
|
Telnet
|
||||||
|
{$ENDIF} ;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
var ComObj : PCommObj;
|
||||||
|
IsTelnet : Boolean;
|
||||||
|
ComHandle : Longint;
|
||||||
|
ReadCH : Char;
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComReadProc(var TempPtr: Pointer);
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
TRUE : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : POs2Obj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
TRUE : PTelnetObj(ComObj)^.Com_ReadProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComReadProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure Int_ComWriteProc(var TempPtr: Pointer);
|
||||||
|
begin
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : PWin32Obj(ComObj)^.Com_DataProc(TempPtr);
|
||||||
|
TRUE : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
Case IsTelnet of
|
||||||
|
FALSE : POs2Obj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
TRUE : PTelnetObj(ComObj)^.Com_WriteProc(TempPtr);
|
||||||
|
end; { case }
|
||||||
|
{$ENDIF}
|
||||||
|
end; { proc. Int_ComWriteProc }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
procedure ParseCommandLine;
|
||||||
|
var Counter: Longint;
|
||||||
|
TempStr: String;
|
||||||
|
{$IFDEF MSDOS}
|
||||||
|
Code : Integer;
|
||||||
|
{$ELSE}
|
||||||
|
Code : Longint;
|
||||||
|
{$ENDIF}
|
||||||
|
begin
|
||||||
|
for Counter := 01 to ParamCount do
|
||||||
|
begin
|
||||||
|
TempStr := ParamStr(Counter);
|
||||||
|
|
||||||
|
if TempStr[1] in ['/', '-'] then
|
||||||
|
Case UpCase(TempStr[2]) of
|
||||||
|
'H' : begin
|
||||||
|
|
||||||
|
TempStr := Copy(TempStr, 3, Length(TempStr) - 2);
|
||||||
|
Val(TempStr, ComHandle, Code);
|
||||||
|
|
||||||
|
|
||||||
|
end; { 'H' }
|
||||||
|
'X' : begin
|
||||||
|
|
||||||
|
if UpCase(TempStr[3]) = 'T' then { XT }
|
||||||
|
IsTelnet := true;
|
||||||
|
|
||||||
|
end; { 'X' }
|
||||||
|
end; { case }
|
||||||
|
|
||||||
|
end; { for }
|
||||||
|
end; { proc. ParseCommandLine }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
Function FStr (N : LongInt) : String; { Convert integer to string }
|
||||||
|
var Temp: String;
|
||||||
|
begin
|
||||||
|
Str(n,temp);
|
||||||
|
FStr:=Temp;
|
||||||
|
end; { func. FStr }
|
||||||
|
|
||||||
|
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
|
||||||
|
|
||||||
|
begin
|
||||||
|
IsTelnet := false;
|
||||||
|
ParseCommandLine;
|
||||||
|
|
||||||
|
{$IFDEF W32COM}
|
||||||
|
if IsTelnet then ComObj := New(PTelnetObj, Init)
|
||||||
|
else ComObj := New(PWin32Obj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF FOSSIL}
|
||||||
|
ComObj := New(PFossilObj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2COM}
|
||||||
|
if IsTelnet then ComObj := New(PTelnetObj, Init)
|
||||||
|
else ComObj := New(POs2Obj, Init);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF WIN32}
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
{$IFDEF OS2}
|
||||||
|
ComObj^.Com_SetDataProc(@Int_ComReadProc, @Int_ComWriteProc);
|
||||||
|
{$ENDIF}
|
||||||
|
|
||||||
|
ComObj^.DontClose := true; { We use an inherited handle, never close it! }
|
||||||
|
ComObj^.Com_OpenQuick(ComHandle); { Open the comport using the handle }
|
||||||
|
ComObj^.Com_SendString('Hello there!' + #13#10);
|
||||||
|
ComObj^.Com_SendString('We are using handle #' + FStr(ComHandle) + #13#10);
|
||||||
|
|
||||||
|
|
||||||
|
repeat
|
||||||
|
ReadCH := ComObj^.Com_GetChar;
|
||||||
|
|
||||||
|
if ReadCH <> #13 then
|
||||||
|
Writeln('Other..');
|
||||||
|
until (ReadCH = #13) OR (NOT ComObj^.Com_Carrier);
|
||||||
|
|
||||||
|
Dispose(ComObj, Done); { Dispose the communications object }
|
||||||
|
end.
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue