diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index 412eeda..0000000 --- a/.gitattributes +++ /dev/null @@ -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 diff --git a/.gitignore b/.gitignore index 5ebd21a..08dc0bf 100644 --- a/.gitignore +++ b/.gitignore @@ -1,163 +1,2 @@ -################# -## Eclipse -################# - -*.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 +EXE/ +ORIGINAL ARCHIVES/ \ No newline at end of file diff --git a/BPC.CFG b/BPC.CFG new file mode 100644 index 0000000..0d1172d --- /dev/null +++ b/BPC.CFG @@ -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 diff --git a/BUILDBP.CMD b/BUILDBP.CMD new file mode 100644 index 0000000..488fd8b --- /dev/null +++ b/BUILDBP.CMD @@ -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 \ No newline at end of file diff --git a/BUILDVP.CMD b/BUILDVP.CMD new file mode 100644 index 0000000..c1b7059 --- /dev/null +++ b/BUILDVP.CMD @@ -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 \ No newline at end of file diff --git a/COMPILE.TXT b/COMPILE.TXT new file mode 100644 index 0000000..d69d5f5 --- /dev/null +++ b/COMPILE.TXT @@ -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 \ No newline at end of file diff --git a/COPYEXEBP.CMD b/COPYEXEBP.CMD new file mode 100644 index 0000000..4233d2a --- /dev/null +++ b/COPYEXEBP.CMD @@ -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\ diff --git a/COPYEXEVP.CMD b/COPYEXEVP.CMD new file mode 100644 index 0000000..b6c69e1 --- /dev/null +++ b/COPYEXEVP.CMD @@ -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 diff --git a/README.md b/README.md new file mode 100644 index 0000000..c24703e --- /dev/null +++ b/README.md @@ -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
+
+This is a fork of the official v1.19 release, which can be found here: https://github.com/Renegade-Exodus/RG119SRC
+ +============================== +Copyright Cott Lang, Patrick Spence, Gary Hall, Jeff Herrings, T.J. McMillen, Chris Hoppman, and Lee Palmer
+Ported to Win32 by Rick Parrish
+ +
+ +TODO list:
+ + +Completed list
+ diff --git a/ARCHIVE1.PAS b/SOURCE/ARCHIVE1.PAS similarity index 100% rename from ARCHIVE1.PAS rename to SOURCE/ARCHIVE1.PAS diff --git a/ARCHIVE2.PAS b/SOURCE/ARCHIVE2.PAS similarity index 100% rename from ARCHIVE2.PAS rename to SOURCE/ARCHIVE2.PAS diff --git a/ARCHIVE3.PAS b/SOURCE/ARCHIVE3.PAS similarity index 100% rename from ARCHIVE3.PAS rename to SOURCE/ARCHIVE3.PAS diff --git a/ARCVIEW.PAS b/SOURCE/ARCVIEW.PAS similarity index 100% rename from ARCVIEW.PAS rename to SOURCE/ARCVIEW.PAS diff --git a/AUTOMSG.PAS b/SOURCE/AUTOMSG.PAS similarity index 100% rename from AUTOMSG.PAS rename to SOURCE/AUTOMSG.PAS diff --git a/BBSLIST.PAS b/SOURCE/BBSLIST.PAS similarity index 100% rename from BBSLIST.PAS rename to SOURCE/BBSLIST.PAS diff --git a/BOOT.PAS b/SOURCE/BOOT.PAS similarity index 100% rename from BOOT.PAS rename to SOURCE/BOOT.PAS diff --git a/BULLETIN.PAS b/SOURCE/BULLETIN.PAS similarity index 100% rename from BULLETIN.PAS rename to SOURCE/BULLETIN.PAS diff --git a/COMMON.PAS b/SOURCE/COMMON.PAS similarity index 100% rename from COMMON.PAS rename to SOURCE/COMMON.PAS diff --git a/COMMON1.PAS b/SOURCE/COMMON1.PAS similarity index 100% rename from COMMON1.PAS rename to SOURCE/COMMON1.PAS diff --git a/COMMON2.PAS b/SOURCE/COMMON2.PAS similarity index 100% rename from COMMON2.PAS rename to SOURCE/COMMON2.PAS diff --git a/COMMON3.PAS b/SOURCE/COMMON3.PAS similarity index 100% rename from COMMON3.PAS rename to SOURCE/COMMON3.PAS diff --git a/COMMON4.PAS b/SOURCE/COMMON4.PAS similarity index 100% rename from COMMON4.PAS rename to SOURCE/COMMON4.PAS diff --git a/COMMON5.PAS b/SOURCE/COMMON5.PAS similarity index 100% rename from COMMON5.PAS rename to SOURCE/COMMON5.PAS diff --git a/CUSER.PAS b/SOURCE/CUSER.PAS similarity index 100% rename from CUSER.PAS rename to SOURCE/CUSER.PAS diff --git a/DOORS.PAS b/SOURCE/DOORS.PAS similarity index 100% rename from DOORS.PAS rename to SOURCE/DOORS.PAS diff --git a/SOURCE/ELECOM/BUFUNIT.PAS b/SOURCE/ELECOM/BUFUNIT.PAS new file mode 100644 index 0000000..6f16c24 --- /dev/null +++ b/SOURCE/ELECOM/BUFUNIT.PAS @@ -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. diff --git a/SOURCE/ELECOM/COMBASE.PAS b/SOURCE/ELECOM/COMBASE.PAS new file mode 100644 index 0000000..dd72401 --- /dev/null +++ b/SOURCE/ELECOM/COMBASE.PAS @@ -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. diff --git a/SOURCE/ELECOM/ELECOM13.PAS b/SOURCE/ELECOM/ELECOM13.PAS new file mode 100644 index 0000000..0e2dc44 --- /dev/null +++ b/SOURCE/ELECOM/ELECOM13.PAS @@ -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. diff --git a/SOURCE/ELECOM/ELEDEF.PAS b/SOURCE/ELECOM/ELEDEF.PAS new file mode 100644 index 0000000..d7d88a5 --- /dev/null +++ b/SOURCE/ELECOM/ELEDEF.PAS @@ -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. diff --git a/SOURCE/ELECOM/ELENORM.PAS b/SOURCE/ELECOM/ELENORM.PAS new file mode 100644 index 0000000..d6b2bc2 --- /dev/null +++ b/SOURCE/ELECOM/ELENORM.PAS @@ -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. diff --git a/SOURCE/ELECOM/EXAM2.PAS b/SOURCE/ELECOM/EXAM2.PAS new file mode 100644 index 0000000..da00107 --- /dev/null +++ b/SOURCE/ELECOM/EXAM2.PAS @@ -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 +** 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. diff --git a/SOURCE/ELECOM/FOS_COM.PAS b/SOURCE/ELECOM/FOS_COM.PAS new file mode 100644 index 0000000..92d0a4a --- /dev/null +++ b/SOURCE/ELECOM/FOS_COM.PAS @@ -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. diff --git a/SOURCE/ELECOM/HISTORY.102 b/SOURCE/ELECOM/HISTORY.102 new file mode 100644 index 0000000..a8b34f6 --- /dev/null +++ b/SOURCE/ELECOM/HISTORY.102 @@ -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. diff --git a/SOURCE/ELECOM/HISTORY.103 b/SOURCE/ELECOM/HISTORY.103 new file mode 100644 index 0000000..c9a944f --- /dev/null +++ b/SOURCE/ELECOM/HISTORY.103 @@ -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. diff --git a/SOURCE/ELECOM/IBMSO32.PAS b/SOURCE/ELECOM/IBMSO32.PAS new file mode 100644 index 0000000..583e395 --- /dev/null +++ b/SOURCE/ELECOM/IBMSO32.PAS @@ -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. diff --git a/SOURCE/ELECOM/IBMTCP32.PAS b/SOURCE/ELECOM/IBMTCP32.PAS new file mode 100644 index 0000000..4b97627 --- /dev/null +++ b/SOURCE/ELECOM/IBMTCP32.PAS @@ -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. diff --git a/SOURCE/ELECOM/OS2COM.PAS b/SOURCE/ELECOM/OS2COM.PAS new file mode 100644 index 0000000..57f620f --- /dev/null +++ b/SOURCE/ELECOM/OS2COM.PAS @@ -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. diff --git a/SOURCE/ELECOM/PROCS.TXT b/SOURCE/ELECOM/PROCS.TXT new file mode 100644 index 0000000..c745fc8 --- /dev/null +++ b/SOURCE/ELECOM/PROCS.TXT @@ -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-+ diff --git a/SOURCE/ELECOM/README.TXT b/SOURCE/ELECOM/README.TXT new file mode 100644 index 0000000..4b4ae4f --- /dev/null +++ b/SOURCE/ELECOM/README.TXT @@ -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 diff --git a/SOURCE/ELECOM/SOCKDEF.PAS b/SOURCE/ELECOM/SOCKDEF.PAS new file mode 100644 index 0000000..fa52e1a --- /dev/null +++ b/SOURCE/ELECOM/SOCKDEF.PAS @@ -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 } diff --git a/SOURCE/ELECOM/SOCKFUNC.PAS b/SOURCE/ELECOM/SOCKFUNC.PAS new file mode 100644 index 0000000..af25063 --- /dev/null +++ b/SOURCE/ELECOM/SOCKFUNC.PAS @@ -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 } diff --git a/SOURCE/ELECOM/SOCKFUNC.RC b/SOURCE/ELECOM/SOCKFUNC.RC new file mode 100644 index 0000000..7123018 --- /dev/null +++ b/SOURCE/ELECOM/SOCKFUNC.RC @@ -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" +} + diff --git a/SOURCE/ELECOM/SOCKFUNC.RES b/SOURCE/ELECOM/SOCKFUNC.RES new file mode 100644 index 0000000..272dc2d Binary files /dev/null and b/SOURCE/ELECOM/SOCKFUNC.RES differ diff --git a/SOURCE/ELECOM/TELNET.PAS b/SOURCE/ELECOM/TELNET.PAS new file mode 100644 index 0000000..dcf5485 --- /dev/null +++ b/SOURCE/ELECOM/TELNET.PAS @@ -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. diff --git a/SOURCE/ELECOM/THREADS.PAS b/SOURCE/ELECOM/THREADS.PAS new file mode 100644 index 0000000..2928452 --- /dev/null +++ b/SOURCE/ELECOM/THREADS.PAS @@ -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. diff --git a/SOURCE/ELECOM/W32SNGL.PAS b/SOURCE/ELECOM/W32SNGL.PAS new file mode 100644 index 0000000..c1afec6 --- /dev/null +++ b/SOURCE/ELECOM/W32SNGL.PAS @@ -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. diff --git a/SOURCE/ELECOM/W32SOCK.PAS b/SOURCE/ELECOM/W32SOCK.PAS new file mode 100644 index 0000000..7885dbb --- /dev/null +++ b/SOURCE/ELECOM/W32SOCK.PAS @@ -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 } diff --git a/SOURCE/ELECOM/WIN32COM.PAS b/SOURCE/ELECOM/WIN32COM.PAS new file mode 100644 index 0000000..008434b --- /dev/null +++ b/SOURCE/ELECOM/WIN32COM.PAS @@ -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. diff --git a/SOURCE/ELECOM/WINDEF.FPC b/SOURCE/ELECOM/WINDEF.FPC new file mode 100644 index 0000000..c8b4756 --- /dev/null +++ b/SOURCE/ELECOM/WINDEF.FPC @@ -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} + + diff --git a/SOURCE/ELECOM/dllexam.pas b/SOURCE/ELECOM/dllexam.pas new file mode 100644 index 0000000..0ef7dc2 --- /dev/null +++ b/SOURCE/ELECOM/dllexam.pas @@ -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. diff --git a/SOURCE/ELECOM/example.pas b/SOURCE/ELECOM/example.pas new file mode 100644 index 0000000..159cfd4 --- /dev/null +++ b/SOURCE/ELECOM/example.pas @@ -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. diff --git a/EMAIL.PAS b/SOURCE/EMAIL.PAS similarity index 100% rename from EMAIL.PAS rename to SOURCE/EMAIL.PAS diff --git a/EVENTS.PAS b/SOURCE/EVENTS.PAS similarity index 100% rename from EVENTS.PAS rename to SOURCE/EVENTS.PAS diff --git a/EXECBAT.PAS b/SOURCE/EXECBAT.PAS similarity index 100% rename from EXECBAT.PAS rename to SOURCE/EXECBAT.PAS diff --git a/FILE0.PAS b/SOURCE/FILE0.PAS similarity index 100% rename from FILE0.PAS rename to SOURCE/FILE0.PAS diff --git a/FILE1.PAS b/SOURCE/FILE1.PAS similarity index 100% rename from FILE1.PAS rename to SOURCE/FILE1.PAS diff --git a/FILE10.PAS b/SOURCE/FILE10.PAS similarity index 100% rename from FILE10.PAS rename to SOURCE/FILE10.PAS diff --git a/FILE11.PAS b/SOURCE/FILE11.PAS similarity index 100% rename from FILE11.PAS rename to SOURCE/FILE11.PAS diff --git a/FILE12.PAS b/SOURCE/FILE12.PAS similarity index 100% rename from FILE12.PAS rename to SOURCE/FILE12.PAS diff --git a/FILE13.PAS b/SOURCE/FILE13.PAS similarity index 100% rename from FILE13.PAS rename to SOURCE/FILE13.PAS diff --git a/FILE14.PAS b/SOURCE/FILE14.PAS similarity index 100% rename from FILE14.PAS rename to SOURCE/FILE14.PAS diff --git a/FILE2.PAS b/SOURCE/FILE2.PAS similarity index 100% rename from FILE2.PAS rename to SOURCE/FILE2.PAS diff --git a/FILE3.PAS b/SOURCE/FILE3.PAS similarity index 100% rename from FILE3.PAS rename to SOURCE/FILE3.PAS diff --git a/FILE4.PAS b/SOURCE/FILE4.PAS similarity index 100% rename from FILE4.PAS rename to SOURCE/FILE4.PAS diff --git a/FILE5.PAS b/SOURCE/FILE5.PAS similarity index 100% rename from FILE5.PAS rename to SOURCE/FILE5.PAS diff --git a/FILE6.PAS b/SOURCE/FILE6.PAS similarity index 100% rename from FILE6.PAS rename to SOURCE/FILE6.PAS diff --git a/FILE7.PAS b/SOURCE/FILE7.PAS similarity index 100% rename from FILE7.PAS rename to SOURCE/FILE7.PAS diff --git a/FILE8.PAS b/SOURCE/FILE8.PAS similarity index 100% rename from FILE8.PAS rename to SOURCE/FILE8.PAS diff --git a/FILE9.PAS b/SOURCE/FILE9.PAS similarity index 100% rename from FILE9.PAS rename to SOURCE/FILE9.PAS diff --git a/LINECHAT.PAS b/SOURCE/LINECHAT.PAS similarity index 100% rename from LINECHAT.PAS rename to SOURCE/LINECHAT.PAS diff --git a/LOGON.PAS b/SOURCE/LOGON.PAS similarity index 100% rename from LOGON.PAS rename to SOURCE/LOGON.PAS diff --git a/MAIL0.PAS b/SOURCE/MAIL0.PAS similarity index 100% rename from MAIL0.PAS rename to SOURCE/MAIL0.PAS diff --git a/MAIL1.PAS b/SOURCE/MAIL1.PAS similarity index 100% rename from MAIL1.PAS rename to SOURCE/MAIL1.PAS diff --git a/MAIL2.PAS b/SOURCE/MAIL2.PAS similarity index 100% rename from MAIL2.PAS rename to SOURCE/MAIL2.PAS diff --git a/MAIL3.PAS b/SOURCE/MAIL3.PAS similarity index 100% rename from MAIL3.PAS rename to SOURCE/MAIL3.PAS diff --git a/MAIL4.PAS b/SOURCE/MAIL4.PAS similarity index 100% rename from MAIL4.PAS rename to SOURCE/MAIL4.PAS diff --git a/MAINT.PAS b/SOURCE/MAINT.PAS similarity index 100% rename from MAINT.PAS rename to SOURCE/MAINT.PAS diff --git a/MENUS.PAS b/SOURCE/MENUS.PAS similarity index 100% rename from MENUS.PAS rename to SOURCE/MENUS.PAS diff --git a/MENUS2.PAS b/SOURCE/MENUS2.PAS similarity index 100% rename from MENUS2.PAS rename to SOURCE/MENUS2.PAS diff --git a/MENUS3.PAS b/SOURCE/MENUS3.PAS similarity index 100% rename from MENUS3.PAS rename to SOURCE/MENUS3.PAS diff --git a/MISCUSER.PAS b/SOURCE/MISCUSER.PAS similarity index 100% rename from MISCUSER.PAS rename to SOURCE/MISCUSER.PAS diff --git a/MSGPACK.PAS b/SOURCE/MSGPACK.PAS similarity index 100% rename from MSGPACK.PAS rename to SOURCE/MSGPACK.PAS diff --git a/MULTNODE.PAS b/SOURCE/MULTNODE.PAS similarity index 100% rename from MULTNODE.PAS rename to SOURCE/MULTNODE.PAS diff --git a/MYIO.PAS b/SOURCE/MYIO.PAS similarity index 100% rename from MYIO.PAS rename to SOURCE/MYIO.PAS diff --git a/NEWUSERS.PAS b/SOURCE/NEWUSERS.PAS similarity index 100% rename from NEWUSERS.PAS rename to SOURCE/NEWUSERS.PAS diff --git a/NODELIST.PAS b/SOURCE/NODELIST.PAS similarity index 100% rename from NODELIST.PAS rename to SOURCE/NODELIST.PAS diff --git a/OFFLINE.PAS b/SOURCE/OFFLINE.PAS similarity index 100% rename from OFFLINE.PAS rename to SOURCE/OFFLINE.PAS diff --git a/RECORDS.PAS b/SOURCE/RECORDS.PAS similarity index 100% rename from RECORDS.PAS rename to SOURCE/RECORDS.PAS diff --git a/RENEGADE.PAS b/SOURCE/RENEGADE.PAS similarity index 100% rename from RENEGADE.PAS rename to SOURCE/RENEGADE.PAS diff --git a/RENEMAIL.PAS b/SOURCE/RENEMAIL.PAS similarity index 100% rename from RENEMAIL.PAS rename to SOURCE/RENEMAIL.PAS diff --git a/RGLNG.PAS b/SOURCE/RGLNG.PAS similarity index 100% rename from RGLNG.PAS rename to SOURCE/RGLNG.PAS diff --git a/RGMAIN.PAS b/SOURCE/RGMAIN.PAS similarity index 100% rename from RGMAIN.PAS rename to SOURCE/RGMAIN.PAS diff --git a/RGNOTE.PAS b/SOURCE/RGNOTE.PAS similarity index 100% rename from RGNOTE.PAS rename to SOURCE/RGNOTE.PAS diff --git a/RGQUOTE.PAS b/SOURCE/RGQUOTE.PAS similarity index 100% rename from RGQUOTE.PAS rename to SOURCE/RGQUOTE.PAS diff --git a/RGSCFG.PAS b/SOURCE/RGSCFG.PAS similarity index 100% rename from RGSCFG.PAS rename to SOURCE/RGSCFG.PAS diff --git a/SCRIPT.PAS b/SOURCE/SCRIPT.PAS similarity index 100% rename from SCRIPT.PAS rename to SOURCE/SCRIPT.PAS diff --git a/SHORTMSG.PAS b/SOURCE/SHORTMSG.PAS similarity index 100% rename from SHORTMSG.PAS rename to SOURCE/SHORTMSG.PAS diff --git a/SPAWNO.PAS b/SOURCE/SPAWNO.PAS similarity index 100% rename from SPAWNO.PAS rename to SOURCE/SPAWNO.PAS diff --git a/SPLITCHA.PAS b/SOURCE/SPLITCHA.PAS similarity index 100% rename from SPLITCHA.PAS rename to SOURCE/SPLITCHA.PAS diff --git a/STATS.PAS b/SOURCE/STATS.PAS similarity index 100% rename from STATS.PAS rename to SOURCE/STATS.PAS diff --git a/SYSOP1.PAS b/SOURCE/SYSOP1.PAS similarity index 100% rename from SYSOP1.PAS rename to SOURCE/SYSOP1.PAS diff --git a/SYSOP10.PAS b/SOURCE/SYSOP10.PAS similarity index 100% rename from SYSOP10.PAS rename to SOURCE/SYSOP10.PAS diff --git a/SYSOP11.PAS b/SOURCE/SYSOP11.PAS similarity index 100% rename from SYSOP11.PAS rename to SOURCE/SYSOP11.PAS diff --git a/SYSOP12.PAS b/SOURCE/SYSOP12.PAS similarity index 100% rename from SYSOP12.PAS rename to SOURCE/SYSOP12.PAS diff --git a/SYSOP2.PAS b/SOURCE/SYSOP2.PAS similarity index 100% rename from SYSOP2.PAS rename to SOURCE/SYSOP2.PAS diff --git a/SYSOP2A.PAS b/SOURCE/SYSOP2A.PAS similarity index 100% rename from SYSOP2A.PAS rename to SOURCE/SYSOP2A.PAS diff --git a/SYSOP2B.PAS b/SOURCE/SYSOP2B.PAS similarity index 100% rename from SYSOP2B.PAS rename to SOURCE/SYSOP2B.PAS diff --git a/SYSOP2C.PAS b/SOURCE/SYSOP2C.PAS similarity index 100% rename from SYSOP2C.PAS rename to SOURCE/SYSOP2C.PAS diff --git a/SYSOP2D.PAS b/SOURCE/SYSOP2D.PAS similarity index 100% rename from SYSOP2D.PAS rename to SOURCE/SYSOP2D.PAS diff --git a/SYSOP2E.PAS b/SOURCE/SYSOP2E.PAS similarity index 100% rename from SYSOP2E.PAS rename to SOURCE/SYSOP2E.PAS diff --git a/SYSOP2F.PAS b/SOURCE/SYSOP2F.PAS similarity index 100% rename from SYSOP2F.PAS rename to SOURCE/SYSOP2F.PAS diff --git a/SYSOP2G.PAS b/SOURCE/SYSOP2G.PAS similarity index 100% rename from SYSOP2G.PAS rename to SOURCE/SYSOP2G.PAS diff --git a/SYSOP2H.PAS b/SOURCE/SYSOP2H.PAS similarity index 100% rename from SYSOP2H.PAS rename to SOURCE/SYSOP2H.PAS diff --git a/SYSOP2I.PAS b/SOURCE/SYSOP2I.PAS similarity index 100% rename from SYSOP2I.PAS rename to SOURCE/SYSOP2I.PAS diff --git a/SYSOP2J.PAS b/SOURCE/SYSOP2J.PAS similarity index 100% rename from SYSOP2J.PAS rename to SOURCE/SYSOP2J.PAS diff --git a/SYSOP2K.PAS b/SOURCE/SYSOP2K.PAS similarity index 100% rename from SYSOP2K.PAS rename to SOURCE/SYSOP2K.PAS diff --git a/SYSOP2L.PAS b/SOURCE/SYSOP2L.PAS similarity index 100% rename from SYSOP2L.PAS rename to SOURCE/SYSOP2L.PAS diff --git a/SYSOP2M.PAS b/SOURCE/SYSOP2M.PAS similarity index 100% rename from SYSOP2M.PAS rename to SOURCE/SYSOP2M.PAS diff --git a/SYSOP2O.PAS b/SOURCE/SYSOP2O.PAS similarity index 100% rename from SYSOP2O.PAS rename to SOURCE/SYSOP2O.PAS diff --git a/SYSOP3.PAS b/SOURCE/SYSOP3.PAS similarity index 100% rename from SYSOP3.PAS rename to SOURCE/SYSOP3.PAS diff --git a/SYSOP4.PAS b/SOURCE/SYSOP4.PAS similarity index 100% rename from SYSOP4.PAS rename to SOURCE/SYSOP4.PAS diff --git a/SYSOP5.PAS b/SOURCE/SYSOP5.PAS similarity index 100% rename from SYSOP5.PAS rename to SOURCE/SYSOP5.PAS diff --git a/SYSOP6.PAS b/SOURCE/SYSOP6.PAS similarity index 100% rename from SYSOP6.PAS rename to SOURCE/SYSOP6.PAS diff --git a/SYSOP7.PAS b/SOURCE/SYSOP7.PAS similarity index 100% rename from SYSOP7.PAS rename to SOURCE/SYSOP7.PAS diff --git a/SYSOP7M.PAS b/SOURCE/SYSOP7M.PAS similarity index 100% rename from SYSOP7M.PAS rename to SOURCE/SYSOP7M.PAS diff --git a/SYSOP8.PAS b/SOURCE/SYSOP8.PAS similarity index 100% rename from SYSOP8.PAS rename to SOURCE/SYSOP8.PAS diff --git a/SYSOP9.PAS b/SOURCE/SYSOP9.PAS similarity index 100% rename from SYSOP9.PAS rename to SOURCE/SYSOP9.PAS diff --git a/TAGLINE.PAS b/SOURCE/TAGLINE.PAS similarity index 100% rename from TAGLINE.PAS rename to SOURCE/TAGLINE.PAS diff --git a/TIMEBANK.PAS b/SOURCE/TIMEBANK.PAS similarity index 100% rename from TIMEBANK.PAS rename to SOURCE/TIMEBANK.PAS diff --git a/TIMEFUNC.PAS b/SOURCE/TIMEFUNC.PAS similarity index 100% rename from TIMEFUNC.PAS rename to SOURCE/TIMEFUNC.PAS diff --git a/ACFLAGS.ASC b/SOURCE/UNUSED/ACFLAGS.ASC similarity index 100% rename from ACFLAGS.ASC rename to SOURCE/UNUSED/ACFLAGS.ASC diff --git a/ARCHIVE1.TPU b/SOURCE/UNUSED/ARCHIVE1.TPU similarity index 100% rename from ARCHIVE1.TPU rename to SOURCE/UNUSED/ARCHIVE1.TPU diff --git a/ARCHIVE2.TPU b/SOURCE/UNUSED/ARCHIVE2.TPU similarity index 100% rename from ARCHIVE2.TPU rename to SOURCE/UNUSED/ARCHIVE2.TPU diff --git a/ARCHIVE3.TPU b/SOURCE/UNUSED/ARCHIVE3.TPU similarity index 100% rename from ARCHIVE3.TPU rename to SOURCE/UNUSED/ARCHIVE3.TPU diff --git a/ARCVIEW.TPU b/SOURCE/UNUSED/ARCVIEW.TPU similarity index 100% rename from ARCVIEW.TPU rename to SOURCE/UNUSED/ARCVIEW.TPU diff --git a/AUTOMSG.TPU b/SOURCE/UNUSED/AUTOMSG.TPU similarity index 100% rename from AUTOMSG.TPU rename to SOURCE/UNUSED/AUTOMSG.TPU diff --git a/BATCH6.LST b/SOURCE/UNUSED/BATCH6.LST similarity index 100% rename from BATCH6.LST rename to SOURCE/UNUSED/BATCH6.LST diff --git a/BBSLIST.TPU b/SOURCE/UNUSED/BBSLIST.TPU similarity index 100% rename from BBSLIST.TPU rename to SOURCE/UNUSED/BBSLIST.TPU diff --git a/BOOT.TPU b/SOURCE/UNUSED/BOOT.TPU similarity index 100% rename from BOOT.TPU rename to SOURCE/UNUSED/BOOT.TPU diff --git a/BULLETIN.TPU b/SOURCE/UNUSED/BULLETIN.TPU similarity index 100% rename from BULLETIN.TPU rename to SOURCE/UNUSED/BULLETIN.TPU diff --git a/CHAIN.TXT b/SOURCE/UNUSED/CHAIN.TXT similarity index 100% rename from CHAIN.TXT rename to SOURCE/UNUSED/CHAIN.TXT diff --git a/CHAINT~1.TXT b/SOURCE/UNUSED/CHAINT~1.TXT similarity index 100% rename from CHAINT~1.TXT rename to SOURCE/UNUSED/CHAINT~1.TXT diff --git a/CHANGE.TXT b/SOURCE/UNUSED/CHANGE.TXT similarity index 100% rename from CHANGE.TXT rename to SOURCE/UNUSED/CHANGE.TXT diff --git a/CHANGE1.TXT b/SOURCE/UNUSED/CHANGE1.TXT similarity index 100% rename from CHANGE1.TXT rename to SOURCE/UNUSED/CHANGE1.TXT diff --git a/CHANGE10.TXT b/SOURCE/UNUSED/CHANGE10.TXT similarity index 100% rename from CHANGE10.TXT rename to SOURCE/UNUSED/CHANGE10.TXT diff --git a/CHANGE11.TXT b/SOURCE/UNUSED/CHANGE11.TXT similarity index 100% rename from CHANGE11.TXT rename to SOURCE/UNUSED/CHANGE11.TXT diff --git a/CHANGE12.TXT b/SOURCE/UNUSED/CHANGE12.TXT similarity index 100% rename from CHANGE12.TXT rename to SOURCE/UNUSED/CHANGE12.TXT diff --git a/CHANGE13.TXT b/SOURCE/UNUSED/CHANGE13.TXT similarity index 100% rename from CHANGE13.TXT rename to SOURCE/UNUSED/CHANGE13.TXT diff --git a/CHANGE14.TXT b/SOURCE/UNUSED/CHANGE14.TXT similarity index 100% rename from CHANGE14.TXT rename to SOURCE/UNUSED/CHANGE14.TXT diff --git a/CHANGE2.TXT b/SOURCE/UNUSED/CHANGE2.TXT similarity index 100% rename from CHANGE2.TXT rename to SOURCE/UNUSED/CHANGE2.TXT diff --git a/CHANGE3.TXT b/SOURCE/UNUSED/CHANGE3.TXT similarity index 100% rename from CHANGE3.TXT rename to SOURCE/UNUSED/CHANGE3.TXT diff --git a/CHANGE4.TXT b/SOURCE/UNUSED/CHANGE4.TXT similarity index 100% rename from CHANGE4.TXT rename to SOURCE/UNUSED/CHANGE4.TXT diff --git a/CHANGE5.TXT b/SOURCE/UNUSED/CHANGE5.TXT similarity index 100% rename from CHANGE5.TXT rename to SOURCE/UNUSED/CHANGE5.TXT diff --git a/CHANGE6.TXT b/SOURCE/UNUSED/CHANGE6.TXT similarity index 100% rename from CHANGE6.TXT rename to SOURCE/UNUSED/CHANGE6.TXT diff --git a/CHANGE7.TXT b/SOURCE/UNUSED/CHANGE7.TXT similarity index 100% rename from CHANGE7.TXT rename to SOURCE/UNUSED/CHANGE7.TXT diff --git a/CHANGE8.TXT b/SOURCE/UNUSED/CHANGE8.TXT similarity index 100% rename from CHANGE8.TXT rename to SOURCE/UNUSED/CHANGE8.TXT diff --git a/CHANGE9.TXT b/SOURCE/UNUSED/CHANGE9.TXT similarity index 100% rename from CHANGE9.TXT rename to SOURCE/UNUSED/CHANGE9.TXT diff --git a/CHANGES.TXT b/SOURCE/UNUSED/CHANGES.TXT similarity index 100% rename from CHANGES.TXT rename to SOURCE/UNUSED/CHANGES.TXT diff --git a/CHANGES1.TXT b/SOURCE/UNUSED/CHANGES1.TXT similarity index 100% rename from CHANGES1.TXT rename to SOURCE/UNUSED/CHANGES1.TXT diff --git a/CHANGES2.TXT b/SOURCE/UNUSED/CHANGES2.TXT similarity index 100% rename from CHANGES2.TXT rename to SOURCE/UNUSED/CHANGES2.TXT diff --git a/CHANGES3.TXT b/SOURCE/UNUSED/CHANGES3.TXT similarity index 100% rename from CHANGES3.TXT rename to SOURCE/UNUSED/CHANGES3.TXT diff --git a/CHANGES4.TXT b/SOURCE/UNUSED/CHANGES4.TXT similarity index 100% rename from CHANGES4.TXT rename to SOURCE/UNUSED/CHANGES4.TXT diff --git a/CHANGES7.TXT b/SOURCE/UNUSED/CHANGES7.TXT similarity index 100% rename from CHANGES7.TXT rename to SOURCE/UNUSED/CHANGES7.TXT diff --git a/CHANGES8.TXT b/SOURCE/UNUSED/CHANGES8.TXT similarity index 100% rename from CHANGES8.TXT rename to SOURCE/UNUSED/CHANGES8.TXT diff --git a/CHANGES9.TXT b/SOURCE/UNUSED/CHANGES9.TXT similarity index 100% rename from CHANGES9.TXT rename to SOURCE/UNUSED/CHANGES9.TXT diff --git a/CHNAGE2.TXT b/SOURCE/UNUSED/CHNAGE2.TXT similarity index 100% rename from CHNAGE2.TXT rename to SOURCE/UNUSED/CHNAGE2.TXT diff --git a/COMMON.TPU b/SOURCE/UNUSED/COMMON.TPU similarity index 100% rename from COMMON.TPU rename to SOURCE/UNUSED/COMMON.TPU diff --git a/COMMON1.TPU b/SOURCE/UNUSED/COMMON1.TPU similarity index 100% rename from COMMON1.TPU rename to SOURCE/UNUSED/COMMON1.TPU diff --git a/COMMON2.TPU b/SOURCE/UNUSED/COMMON2.TPU similarity index 100% rename from COMMON2.TPU rename to SOURCE/UNUSED/COMMON2.TPU diff --git a/COMMON3.TPU b/SOURCE/UNUSED/COMMON3.TPU similarity index 100% rename from COMMON3.TPU rename to SOURCE/UNUSED/COMMON3.TPU diff --git a/COMMON4.TPU b/SOURCE/UNUSED/COMMON4.TPU similarity index 100% rename from COMMON4.TPU rename to SOURCE/UNUSED/COMMON4.TPU diff --git a/COMMON5.TPU b/SOURCE/UNUSED/COMMON5.TPU similarity index 100% rename from COMMON5.TPU rename to SOURCE/UNUSED/COMMON5.TPU diff --git a/CRC32.ASM b/SOURCE/UNUSED/CRC32.ASM similarity index 100% rename from CRC32.ASM rename to SOURCE/UNUSED/CRC32.ASM diff --git a/CRC32A.PAS b/SOURCE/UNUSED/CRC32A.PAS similarity index 100% rename from CRC32A.PAS rename to SOURCE/UNUSED/CRC32A.PAS diff --git a/CUSER.TPU b/SOURCE/UNUSED/CUSER.TPU similarity index 100% rename from CUSER.TPU rename to SOURCE/UNUSED/CUSER.TPU diff --git a/DEZIP.PAS b/SOURCE/UNUSED/DEZIP.PAS similarity index 100% rename from DEZIP.PAS rename to SOURCE/UNUSED/DEZIP.PAS diff --git a/DOOR.SYS b/SOURCE/UNUSED/DOOR.SYS similarity index 100% rename from DOOR.SYS rename to SOURCE/UNUSED/DOOR.SYS diff --git a/DOOR32.SYS b/SOURCE/UNUSED/DOOR32.SYS similarity index 100% rename from DOOR32.SYS rename to SOURCE/UNUSED/DOOR32.SYS diff --git a/DOOR32~1.TXT b/SOURCE/UNUSED/DOOR32~1.TXT similarity index 100% rename from DOOR32~1.TXT rename to SOURCE/UNUSED/DOOR32~1.TXT diff --git a/DOORS.TPU b/SOURCE/UNUSED/DOORS.TPU similarity index 100% rename from DOORS.TPU rename to SOURCE/UNUSED/DOORS.TPU diff --git a/DOORSY~1.DOC b/SOURCE/UNUSED/DOORSY~1.DOC similarity index 100% rename from DOORSY~1.DOC rename to SOURCE/UNUSED/DOORSY~1.DOC diff --git a/DORINFO1.DEF b/SOURCE/UNUSED/DORINFO1.DEF similarity index 100% rename from DORINFO1.DEF rename to SOURCE/UNUSED/DORINFO1.DEF diff --git a/DORINF~1.TXT b/SOURCE/UNUSED/DORINF~1.TXT similarity index 100% rename from DORINF~1.TXT rename to SOURCE/UNUSED/DORINF~1.TXT diff --git a/DRAG_010.PAS b/SOURCE/UNUSED/DRAG_010.PAS similarity index 100% rename from DRAG_010.PAS rename to SOURCE/UNUSED/DRAG_010.PAS diff --git a/EC.PAS b/SOURCE/UNUSED/EC.PAS similarity index 100% rename from EC.PAS rename to SOURCE/UNUSED/EC.PAS diff --git a/EC.TXT b/SOURCE/UNUSED/EC.TXT similarity index 100% rename from EC.TXT rename to SOURCE/UNUSED/EC.TXT diff --git a/EMAIL.TPU b/SOURCE/UNUSED/EMAIL.TPU similarity index 100% rename from EMAIL.TPU rename to SOURCE/UNUSED/EMAIL.TPU diff --git a/ERROR.LOG b/SOURCE/UNUSED/ERROR.LOG similarity index 100% rename from ERROR.LOG rename to SOURCE/UNUSED/ERROR.LOG diff --git a/EVENT.PAS b/SOURCE/UNUSED/EVENT.PAS similarity index 100% rename from EVENT.PAS rename to SOURCE/UNUSED/EVENT.PAS diff --git a/EVENT.TPU b/SOURCE/UNUSED/EVENT.TPU similarity index 100% rename from EVENT.TPU rename to SOURCE/UNUSED/EVENT.TPU diff --git a/EVENTS.TPU b/SOURCE/UNUSED/EVENTS.TPU similarity index 100% rename from EVENTS.TPU rename to SOURCE/UNUSED/EVENTS.TPU diff --git a/EXECBAT.TPU b/SOURCE/UNUSED/EXECBAT.TPU similarity index 100% rename from EXECBAT.TPU rename to SOURCE/UNUSED/EXECBAT.TPU diff --git a/FAELNG.EXE b/SOURCE/UNUSED/FAELNG.EXE similarity index 100% rename from FAELNG.EXE rename to SOURCE/UNUSED/FAELNG.EXE diff --git a/FAELNG.PAS b/SOURCE/UNUSED/FAELNG.PAS similarity index 100% rename from FAELNG.PAS rename to SOURCE/UNUSED/FAELNG.PAS diff --git a/FAELNG.TXT b/SOURCE/UNUSED/FAELNG.TXT similarity index 100% rename from FAELNG.TXT rename to SOURCE/UNUSED/FAELNG.TXT diff --git a/FAEPR.DAT b/SOURCE/UNUSED/FAEPR.DAT similarity index 100% rename from FAEPR.DAT rename to SOURCE/UNUSED/FAEPR.DAT diff --git a/FAETX.DAT b/SOURCE/UNUSED/FAETX.DAT similarity index 100% rename from FAETX.DAT rename to SOURCE/UNUSED/FAETX.DAT diff --git a/FILE0.TPU b/SOURCE/UNUSED/FILE0.TPU similarity index 100% rename from FILE0.TPU rename to SOURCE/UNUSED/FILE0.TPU diff --git a/FILE1.TPU b/SOURCE/UNUSED/FILE1.TPU similarity index 100% rename from FILE1.TPU rename to SOURCE/UNUSED/FILE1.TPU diff --git a/FILE10.LEE b/SOURCE/UNUSED/FILE10.LEE similarity index 100% rename from FILE10.LEE rename to SOURCE/UNUSED/FILE10.LEE diff --git a/FILE10.TPU b/SOURCE/UNUSED/FILE10.TPU similarity index 100% rename from FILE10.TPU rename to SOURCE/UNUSED/FILE10.TPU diff --git a/FILE11.TPU b/SOURCE/UNUSED/FILE11.TPU similarity index 100% rename from FILE11.TPU rename to SOURCE/UNUSED/FILE11.TPU diff --git a/FILE12.TPU b/SOURCE/UNUSED/FILE12.TPU similarity index 100% rename from FILE12.TPU rename to SOURCE/UNUSED/FILE12.TPU diff --git a/FILE13.TPU b/SOURCE/UNUSED/FILE13.TPU similarity index 100% rename from FILE13.TPU rename to SOURCE/UNUSED/FILE13.TPU diff --git a/FILE14.TPU b/SOURCE/UNUSED/FILE14.TPU similarity index 100% rename from FILE14.TPU rename to SOURCE/UNUSED/FILE14.TPU diff --git a/FILE2.TPU b/SOURCE/UNUSED/FILE2.TPU similarity index 100% rename from FILE2.TPU rename to SOURCE/UNUSED/FILE2.TPU diff --git a/FILE3.TPU b/SOURCE/UNUSED/FILE3.TPU similarity index 100% rename from FILE3.TPU rename to SOURCE/UNUSED/FILE3.TPU diff --git a/FILE4.TPU b/SOURCE/UNUSED/FILE4.TPU similarity index 100% rename from FILE4.TPU rename to SOURCE/UNUSED/FILE4.TPU diff --git a/FILE5.TPU b/SOURCE/UNUSED/FILE5.TPU similarity index 100% rename from FILE5.TPU rename to SOURCE/UNUSED/FILE5.TPU diff --git a/FILE6.TPU b/SOURCE/UNUSED/FILE6.TPU similarity index 100% rename from FILE6.TPU rename to SOURCE/UNUSED/FILE6.TPU diff --git a/FILE7.TPU b/SOURCE/UNUSED/FILE7.TPU similarity index 100% rename from FILE7.TPU rename to SOURCE/UNUSED/FILE7.TPU diff --git a/FILE8.TPU b/SOURCE/UNUSED/FILE8.TPU similarity index 100% rename from FILE8.TPU rename to SOURCE/UNUSED/FILE8.TPU diff --git a/FILE9.TPU b/SOURCE/UNUSED/FILE9.TPU similarity index 100% rename from FILE9.TPU rename to SOURCE/UNUSED/FILE9.TPU diff --git a/FILES.BBS b/SOURCE/UNUSED/FILES.BBS similarity index 100% rename from FILES.BBS rename to SOURCE/UNUSED/FILES.BBS diff --git a/FSHELP.ASC b/SOURCE/UNUSED/FSHELP.ASC similarity index 100% rename from FSHELP.ASC rename to SOURCE/UNUSED/FSHELP.ASC diff --git a/FSTR.PAS b/SOURCE/UNUSED/FSTR.PAS similarity index 100% rename from FSTR.PAS rename to SOURCE/UNUSED/FSTR.PAS diff --git a/FTS-0001.016 b/SOURCE/UNUSED/FTS-0001.016 similarity index 100% rename from FTS-0001.016 rename to SOURCE/UNUSED/FTS-0001.016 diff --git a/GREP.COM b/SOURCE/UNUSED/GREP.COM similarity index 100% rename from GREP.COM rename to SOURCE/UNUSED/GREP.COM diff --git a/INSTALL.EXE b/SOURCE/UNUSED/INSTALL.EXE similarity index 100% rename from INSTALL.EXE rename to SOURCE/UNUSED/INSTALL.EXE diff --git a/INSTALL.PAS b/SOURCE/UNUSED/INSTALL.PAS similarity index 100% rename from INSTALL.PAS rename to SOURCE/UNUSED/INSTALL.PAS diff --git a/IS286.PAS b/SOURCE/UNUSED/IS286.PAS similarity index 100% rename from IS286.PAS rename to SOURCE/UNUSED/IS286.PAS diff --git a/LEE.EXE b/SOURCE/UNUSED/LEE.EXE similarity index 100% rename from LEE.EXE rename to SOURCE/UNUSED/LEE.EXE diff --git a/LEE.PAS b/SOURCE/UNUSED/LEE.PAS similarity index 100% rename from LEE.PAS rename to SOURCE/UNUSED/LEE.PAS diff --git a/LEE.TXT b/SOURCE/UNUSED/LEE.TXT similarity index 100% rename from LEE.TXT rename to SOURCE/UNUSED/LEE.TXT diff --git a/LGNQUOTE.DAT b/SOURCE/UNUSED/LGNQUOTE.DAT similarity index 100% rename from LGNQUOTE.DAT rename to SOURCE/UNUSED/LGNQUOTE.DAT diff --git a/LGNQUOTE.PTR b/SOURCE/UNUSED/LGNQUOTE.PTR similarity index 100% rename from LGNQUOTE.PTR rename to SOURCE/UNUSED/LGNQUOTE.PTR diff --git a/LGNQUOTE.TXT b/SOURCE/UNUSED/LGNQUOTE.TXT similarity index 100% rename from LGNQUOTE.TXT rename to SOURCE/UNUSED/LGNQUOTE.TXT diff --git a/LINECHAT.TPU b/SOURCE/UNUSED/LINECHAT.TPU similarity index 100% rename from LINECHAT.TPU rename to SOURCE/UNUSED/LINECHAT.TPU diff --git a/LOGON.BAT b/SOURCE/UNUSED/LOGON.BAT similarity index 100% rename from LOGON.BAT rename to SOURCE/UNUSED/LOGON.BAT diff --git a/LOGON.TPU b/SOURCE/UNUSED/LOGON.TPU similarity index 100% rename from LOGON.TPU rename to SOURCE/UNUSED/LOGON.TPU diff --git a/MAIL0.TPU b/SOURCE/UNUSED/MAIL0.TPU similarity index 100% rename from MAIL0.TPU rename to SOURCE/UNUSED/MAIL0.TPU diff --git a/MAIL1.LEE b/SOURCE/UNUSED/MAIL1.LEE similarity index 100% rename from MAIL1.LEE rename to SOURCE/UNUSED/MAIL1.LEE diff --git a/MAIL1.TPU b/SOURCE/UNUSED/MAIL1.TPU similarity index 100% rename from MAIL1.TPU rename to SOURCE/UNUSED/MAIL1.TPU diff --git a/MAIL2.TPU b/SOURCE/UNUSED/MAIL2.TPU similarity index 100% rename from MAIL2.TPU rename to SOURCE/UNUSED/MAIL2.TPU diff --git a/MAIL3.TPU b/SOURCE/UNUSED/MAIL3.TPU similarity index 100% rename from MAIL3.TPU rename to SOURCE/UNUSED/MAIL3.TPU diff --git a/MAIL4.TPU b/SOURCE/UNUSED/MAIL4.TPU similarity index 100% rename from MAIL4.TPU rename to SOURCE/UNUSED/MAIL4.TPU diff --git a/MAIL5.PAS b/SOURCE/UNUSED/MAIL5.PAS similarity index 100% rename from MAIL5.PAS rename to SOURCE/UNUSED/MAIL5.PAS diff --git a/MAIL5.TPU b/SOURCE/UNUSED/MAIL5.TPU similarity index 100% rename from MAIL5.TPU rename to SOURCE/UNUSED/MAIL5.TPU diff --git a/MAIL6.PAS b/SOURCE/UNUSED/MAIL6.PAS similarity index 100% rename from MAIL6.PAS rename to SOURCE/UNUSED/MAIL6.PAS diff --git a/MAIL6.TPU b/SOURCE/UNUSED/MAIL6.TPU similarity index 100% rename from MAIL6.TPU rename to SOURCE/UNUSED/MAIL6.TPU diff --git a/MAIL7.PAS b/SOURCE/UNUSED/MAIL7.PAS similarity index 100% rename from MAIL7.PAS rename to SOURCE/UNUSED/MAIL7.PAS diff --git a/MAIL7.TPU b/SOURCE/UNUSED/MAIL7.TPU similarity index 100% rename from MAIL7.TPU rename to SOURCE/UNUSED/MAIL7.TPU diff --git a/MAINT.TPU b/SOURCE/UNUSED/MAINT.TPU similarity index 100% rename from MAINT.TPU rename to SOURCE/UNUSED/MAINT.TPU diff --git a/MARRIAGE.DAT b/SOURCE/UNUSED/MARRIAGE.DAT similarity index 100% rename from MARRIAGE.DAT rename to SOURCE/UNUSED/MARRIAGE.DAT diff --git a/MARRIAGE.PTR b/SOURCE/UNUSED/MARRIAGE.PTR similarity index 100% rename from MARRIAGE.PTR rename to SOURCE/UNUSED/MARRIAGE.PTR diff --git a/MARRIAGE.TXT b/SOURCE/UNUSED/MARRIAGE.TXT similarity index 100% rename from MARRIAGE.TXT rename to SOURCE/UNUSED/MARRIAGE.TXT diff --git a/MENUS.TPU b/SOURCE/UNUSED/MENUS.TPU similarity index 100% rename from MENUS.TPU rename to SOURCE/UNUSED/MENUS.TPU diff --git a/MENUS2.TPU b/SOURCE/UNUSED/MENUS2.TPU similarity index 100% rename from MENUS2.TPU rename to SOURCE/UNUSED/MENUS2.TPU diff --git a/MENUS3.TPU b/SOURCE/UNUSED/MENUS3.TPU similarity index 100% rename from MENUS3.TPU rename to SOURCE/UNUSED/MENUS3.TPU diff --git a/MENUS4.PAS b/SOURCE/UNUSED/MENUS4.PAS similarity index 100% rename from MENUS4.PAS rename to SOURCE/UNUSED/MENUS4.PAS diff --git a/MENUS4.TPU b/SOURCE/UNUSED/MENUS4.TPU similarity index 100% rename from MENUS4.TPU rename to SOURCE/UNUSED/MENUS4.TPU diff --git a/MISCCHAT.PAS b/SOURCE/UNUSED/MISCCHAT.PAS similarity index 100% rename from MISCCHAT.PAS rename to SOURCE/UNUSED/MISCCHAT.PAS diff --git a/MISCUSER.TPU b/SOURCE/UNUSED/MISCUSER.TPU similarity index 100% rename from MISCUSER.TPU rename to SOURCE/UNUSED/MISCUSER.TPU diff --git a/MSGPACK.TPU b/SOURCE/UNUSED/MSGPACK.TPU similarity index 100% rename from MSGPACK.TPU rename to SOURCE/UNUSED/MSGPACK.TPU diff --git a/MSGQUOTE.DAT b/SOURCE/UNUSED/MSGQUOTE.DAT similarity index 100% rename from MSGQUOTE.DAT rename to SOURCE/UNUSED/MSGQUOTE.DAT diff --git a/MSGQUOTE.PTR b/SOURCE/UNUSED/MSGQUOTE.PTR similarity index 100% rename from MSGQUOTE.PTR rename to SOURCE/UNUSED/MSGQUOTE.PTR diff --git a/MSGQUOTE.TXT b/SOURCE/UNUSED/MSGQUOTE.TXT similarity index 100% rename from MSGQUOTE.TXT rename to SOURCE/UNUSED/MSGQUOTE.TXT diff --git a/MULT.PAS b/SOURCE/UNUSED/MULT.PAS similarity index 100% rename from MULT.PAS rename to SOURCE/UNUSED/MULT.PAS diff --git a/MULTNODE.TPU b/SOURCE/UNUSED/MULTNODE.TPU similarity index 100% rename from MULTNODE.TPU rename to SOURCE/UNUSED/MULTNODE.TPU diff --git a/MYIO.TPU b/SOURCE/UNUSED/MYIO.TPU similarity index 100% rename from MYIO.TPU rename to SOURCE/UNUSED/MYIO.TPU diff --git a/NEWMCI.TXT b/SOURCE/UNUSED/NEWMCI.TXT similarity index 100% rename from NEWMCI.TXT rename to SOURCE/UNUSED/NEWMCI.TXT diff --git a/NEWUSERS.TPU b/SOURCE/UNUSED/NEWUSERS.TPU similarity index 100% rename from NEWUSERS.TPU rename to SOURCE/UNUSED/NEWUSERS.TPU diff --git a/NODELIST.TPU b/SOURCE/UNUSED/NODELIST.TPU similarity index 100% rename from NODELIST.TPU rename to SOURCE/UNUSED/NODELIST.TPU diff --git a/NONAME00.EXE b/SOURCE/UNUSED/NONAME00.EXE similarity index 100% rename from NONAME00.EXE rename to SOURCE/UNUSED/NONAME00.EXE diff --git a/OFFLINE.TPU b/SOURCE/UNUSED/OFFLINE.TPU similarity index 100% rename from OFFLINE.TPU rename to SOURCE/UNUSED/OFFLINE.TPU diff --git a/OVRUMB.DOC b/SOURCE/UNUSED/OVRUMB.DOC similarity index 100% rename from OVRUMB.DOC rename to SOURCE/UNUSED/OVRUMB.DOC diff --git a/OVRUMB.PAS b/SOURCE/UNUSED/OVRUMB.PAS similarity index 100% rename from OVRUMB.PAS rename to SOURCE/UNUSED/OVRUMB.PAS diff --git a/OVRUMB.TPU b/SOURCE/UNUSED/OVRUMB.TPU similarity index 100% rename from OVRUMB.TPU rename to SOURCE/UNUSED/OVRUMB.TPU diff --git a/PCBOAR~1.TXT b/SOURCE/UNUSED/PCBOAR~1.TXT similarity index 100% rename from PCBOAR~1.TXT rename to SOURCE/UNUSED/PCBOAR~1.TXT diff --git a/PKUNZIP.EXE b/SOURCE/UNUSED/PKUNZIP.EXE similarity index 100% rename from PKUNZIP.EXE rename to SOURCE/UNUSED/PKUNZIP.EXE diff --git a/PKZIP.EXE b/SOURCE/UNUSED/PKZIP.EXE similarity index 100% rename from PKZIP.EXE rename to SOURCE/UNUSED/PKZIP.EXE diff --git a/PRHELP.ASC b/SOURCE/UNUSED/PRHELP.ASC similarity index 100% rename from PRHELP.ASC rename to SOURCE/UNUSED/PRHELP.ASC diff --git a/RENEGADE.DAT b/SOURCE/UNUSED/RENEGADE.DAT similarity index 100% rename from RENEGADE.DAT rename to SOURCE/UNUSED/RENEGADE.DAT diff --git a/RENEGADE.EXE b/SOURCE/UNUSED/RENEGADE.EXE similarity index 100% rename from RENEGADE.EXE rename to SOURCE/UNUSED/RENEGADE.EXE diff --git a/RENEGADE.LNG b/SOURCE/UNUSED/RENEGADE.LNG similarity index 100% rename from RENEGADE.LNG rename to SOURCE/UNUSED/RENEGADE.LNG diff --git a/RENEGADE.OVR b/SOURCE/UNUSED/RENEGADE.OVR similarity index 100% rename from RENEGADE.OVR rename to SOURCE/UNUSED/RENEGADE.OVR diff --git a/RENEGADE.PIF b/SOURCE/UNUSED/RENEGADE.PIF similarity index 100% rename from RENEGADE.PIF rename to SOURCE/UNUSED/RENEGADE.PIF diff --git a/RENEGADE.TPH b/SOURCE/UNUSED/RENEGADE.TPH similarity index 100% rename from RENEGADE.TPH rename to SOURCE/UNUSED/RENEGADE.TPH diff --git a/RENEMAIL.EXE b/SOURCE/UNUSED/RENEMAIL.EXE similarity index 100% rename from RENEMAIL.EXE rename to SOURCE/UNUSED/RENEMAIL.EXE diff --git a/RENEMAIL.TPH b/SOURCE/UNUSED/RENEMAIL.TPH similarity index 100% rename from RENEMAIL.TPH rename to SOURCE/UNUSED/RENEMAIL.TPH diff --git a/REUPDATE.PAS b/SOURCE/UNUSED/REUPDATE.PAS similarity index 100% rename from REUPDATE.PAS rename to SOURCE/UNUSED/REUPDATE.PAS diff --git a/RGAPI.PAS b/SOURCE/UNUSED/RGAPI.PAS similarity index 100% rename from RGAPI.PAS rename to SOURCE/UNUSED/RGAPI.PAS diff --git a/RGFLIST.PAS b/SOURCE/UNUSED/RGFLIST.PAS similarity index 100% rename from RGFLIST.PAS rename to SOURCE/UNUSED/RGFLIST.PAS diff --git a/RGINTRO.ANS b/SOURCE/UNUSED/RGINTRO.ANS similarity index 100% rename from RGINTRO.ANS rename to SOURCE/UNUSED/RGINTRO.ANS diff --git a/RGLNG.EXE b/SOURCE/UNUSED/RGLNG.EXE similarity index 100% rename from RGLNG.EXE rename to SOURCE/UNUSED/RGLNG.EXE diff --git a/RGLNG.TXT b/SOURCE/UNUSED/RGLNG.TXT similarity index 100% rename from RGLNG.TXT rename to SOURCE/UNUSED/RGLNG.TXT diff --git a/RGLNGNEW.TXT b/SOURCE/UNUSED/RGLNGNEW.TXT similarity index 100% rename from RGLNGNEW.TXT rename to SOURCE/UNUSED/RGLNGNEW.TXT diff --git a/RGLNGPR.DAT b/SOURCE/UNUSED/RGLNGPR.DAT similarity index 100% rename from RGLNGPR.DAT rename to SOURCE/UNUSED/RGLNGPR.DAT diff --git a/RGLNGTX.DAT b/SOURCE/UNUSED/RGLNGTX.DAT similarity index 100% rename from RGLNGTX.DAT rename to SOURCE/UNUSED/RGLNGTX.DAT diff --git a/RGMAIN.EXE b/SOURCE/UNUSED/RGMAIN.EXE similarity index 100% rename from RGMAIN.EXE rename to SOURCE/UNUSED/RGMAIN.EXE diff --git a/RGMAIN.TXT b/SOURCE/UNUSED/RGMAIN.TXT similarity index 100% rename from RGMAIN.TXT rename to SOURCE/UNUSED/RGMAIN.TXT diff --git a/RGMAINPR.DAT b/SOURCE/UNUSED/RGMAINPR.DAT similarity index 100% rename from RGMAINPR.DAT rename to SOURCE/UNUSED/RGMAINPR.DAT diff --git a/RGMAINT.EXE b/SOURCE/UNUSED/RGMAINT.EXE similarity index 100% rename from RGMAINT.EXE rename to SOURCE/UNUSED/RGMAINT.EXE diff --git a/RGMAINT.PAS b/SOURCE/UNUSED/RGMAINT.PAS similarity index 100% rename from RGMAINT.PAS rename to SOURCE/UNUSED/RGMAINT.PAS diff --git a/RGMAINT1.PAS b/SOURCE/UNUSED/RGMAINT1.PAS similarity index 100% rename from RGMAINT1.PAS rename to SOURCE/UNUSED/RGMAINT1.PAS diff --git a/RGMAINT2.PAS b/SOURCE/UNUSED/RGMAINT2.PAS similarity index 100% rename from RGMAINT2.PAS rename to SOURCE/UNUSED/RGMAINT2.PAS diff --git a/RGMAINTX.DAT b/SOURCE/UNUSED/RGMAINTX.DAT similarity index 100% rename from RGMAINTX.DAT rename to SOURCE/UNUSED/RGMAINTX.DAT diff --git a/RGNOTE.EXE b/SOURCE/UNUSED/RGNOTE.EXE similarity index 100% rename from RGNOTE.EXE rename to SOURCE/UNUSED/RGNOTE.EXE diff --git a/RGNOTE.TXT b/SOURCE/UNUSED/RGNOTE.TXT similarity index 100% rename from RGNOTE.TXT rename to SOURCE/UNUSED/RGNOTE.TXT diff --git a/RGNOTEPR.DAT b/SOURCE/UNUSED/RGNOTEPR.DAT similarity index 100% rename from RGNOTEPR.DAT rename to SOURCE/UNUSED/RGNOTEPR.DAT diff --git a/RGNOTETX.DAT b/SOURCE/UNUSED/RGNOTETX.DAT similarity index 100% rename from RGNOTETX.DAT rename to SOURCE/UNUSED/RGNOTETX.DAT diff --git a/RGQUOTE.EXE b/SOURCE/UNUSED/RGQUOTE.EXE similarity index 100% rename from RGQUOTE.EXE rename to SOURCE/UNUSED/RGQUOTE.EXE diff --git a/RGSCFG.EXE b/SOURCE/UNUSED/RGSCFG.EXE similarity index 100% rename from RGSCFG.EXE rename to SOURCE/UNUSED/RGSCFG.EXE diff --git a/RGSCFG.TXT b/SOURCE/UNUSED/RGSCFG.TXT similarity index 100% rename from RGSCFG.TXT rename to SOURCE/UNUSED/RGSCFG.TXT diff --git a/RGSCFGPR.DAT b/SOURCE/UNUSED/RGSCFGPR.DAT similarity index 100% rename from RGSCFGPR.DAT rename to SOURCE/UNUSED/RGSCFGPR.DAT diff --git a/RGSCFGTX.DAT b/SOURCE/UNUSED/RGSCFGTX.DAT similarity index 100% rename from RGSCFGTX.DAT rename to SOURCE/UNUSED/RGSCFGTX.DAT diff --git a/RGSTAT.PAS b/SOURCE/UNUSED/RGSTAT.PAS similarity index 100% rename from RGSTAT.PAS rename to SOURCE/UNUSED/RGSTAT.PAS diff --git a/RGUPDATE.EXE b/SOURCE/UNUSED/RGUPDATE.EXE similarity index 100% rename from RGUPDATE.EXE rename to SOURCE/UNUSED/RGUPDATE.EXE diff --git a/RGUPDATE.PAS b/SOURCE/UNUSED/RGUPDATE.PAS similarity index 100% rename from RGUPDATE.PAS rename to SOURCE/UNUSED/RGUPDATE.PAS diff --git a/RGUPDT1.EXE b/SOURCE/UNUSED/RGUPDT1.EXE similarity index 100% rename from RGUPDT1.EXE rename to SOURCE/UNUSED/RGUPDT1.EXE diff --git a/RGUPDT1.PAS b/SOURCE/UNUSED/RGUPDT1.PAS similarity index 100% rename from RGUPDT1.PAS rename to SOURCE/UNUSED/RGUPDT1.PAS diff --git a/RGUPDT2.EXE b/SOURCE/UNUSED/RGUPDT2.EXE similarity index 100% rename from RGUPDT2.EXE rename to SOURCE/UNUSED/RGUPDT2.EXE diff --git a/RGUPDT2.PAS b/SOURCE/UNUSED/RGUPDT2.PAS similarity index 100% rename from RGUPDT2.PAS rename to SOURCE/UNUSED/RGUPDT2.PAS diff --git a/RGUPDT3.EXE b/SOURCE/UNUSED/RGUPDT3.EXE similarity index 100% rename from RGUPDT3.EXE rename to SOURCE/UNUSED/RGUPDT3.EXE diff --git a/RGUPDT3.PAS b/SOURCE/UNUSED/RGUPDT3.PAS similarity index 100% rename from RGUPDT3.PAS rename to SOURCE/UNUSED/RGUPDT3.PAS diff --git a/RGUPDT4.PAS b/SOURCE/UNUSED/RGUPDT4.PAS similarity index 100% rename from RGUPDT4.PAS rename to SOURCE/UNUSED/RGUPDT4.PAS diff --git a/RGV118.EXE b/SOURCE/UNUSED/RGV118.EXE similarity index 100% rename from RGV118.EXE rename to SOURCE/UNUSED/RGV118.EXE diff --git a/RGV118.PAS b/SOURCE/UNUSED/RGV118.PAS similarity index 100% rename from RGV118.PAS rename to SOURCE/UNUSED/RGV118.PAS diff --git a/RGVER.EXE b/SOURCE/UNUSED/RGVER.EXE similarity index 100% rename from RGVER.EXE rename to SOURCE/UNUSED/RGVER.EXE diff --git a/RGVER.PAS b/SOURCE/UNUSED/RGVER.PAS similarity index 100% rename from RGVER.PAS rename to SOURCE/UNUSED/RGVER.PAS diff --git a/RGVERUDT.EXE b/SOURCE/UNUSED/RGVERUDT.EXE similarity index 100% rename from RGVERUDT.EXE rename to SOURCE/UNUSED/RGVERUDT.EXE diff --git a/RGVERUDT.PAS b/SOURCE/UNUSED/RGVERUDT.PAS similarity index 100% rename from RGVERUDT.PAS rename to SOURCE/UNUSED/RGVERUDT.PAS diff --git a/RMAILWKS.PAS b/SOURCE/UNUSED/RMAILWKS.PAS similarity index 100% rename from RMAILWKS.PAS rename to SOURCE/UNUSED/RMAILWKS.PAS diff --git a/RMCHANGE.DOC b/SOURCE/UNUSED/RMCHANGE.DOC similarity index 100% rename from RMCHANGE.DOC rename to SOURCE/UNUSED/RMCHANGE.DOC diff --git a/RMUPDATE.DOC b/SOURCE/UNUSED/RMUPDATE.DOC similarity index 100% rename from RMUPDATE.DOC rename to SOURCE/UNUSED/RMUPDATE.DOC diff --git a/SCRIPT.TPU b/SOURCE/UNUSED/SCRIPT.TPU similarity index 100% rename from SCRIPT.TPU rename to SOURCE/UNUSED/SCRIPT.TPU diff --git a/SHORTMSG.TPU b/SOURCE/UNUSED/SHORTMSG.TPU similarity index 100% rename from SHORTMSG.TPU rename to SOURCE/UNUSED/SHORTMSG.TPU diff --git a/SORTING.PAS b/SOURCE/UNUSED/SORTING.PAS similarity index 100% rename from SORTING.PAS rename to SOURCE/UNUSED/SORTING.PAS diff --git a/SPAWNO.TPU b/SOURCE/UNUSED/SPAWNO.TPU similarity index 100% rename from SPAWNO.TPU rename to SOURCE/UNUSED/SPAWNO.TPU diff --git a/SPLITCHA.TPU b/SOURCE/UNUSED/SPLITCHA.TPU similarity index 100% rename from SPLITCHA.TPU rename to SOURCE/UNUSED/SPLITCHA.TPU diff --git a/STATS.TPU b/SOURCE/UNUSED/STATS.TPU similarity index 100% rename from STATS.TPU rename to SOURCE/UNUSED/STATS.TPU diff --git a/SYSCHAT.PAS b/SOURCE/UNUSED/SYSCHAT.PAS similarity index 100% rename from SYSCHAT.PAS rename to SOURCE/UNUSED/SYSCHAT.PAS diff --git a/SYSCHAT.TPU b/SOURCE/UNUSED/SYSCHAT.TPU similarity index 100% rename from SYSCHAT.TPU rename to SOURCE/UNUSED/SYSCHAT.TPU diff --git a/SYSOP1.TPU b/SOURCE/UNUSED/SYSOP1.TPU similarity index 100% rename from SYSOP1.TPU rename to SOURCE/UNUSED/SYSOP1.TPU diff --git a/SYSOP10.TPU b/SOURCE/UNUSED/SYSOP10.TPU similarity index 100% rename from SYSOP10.TPU rename to SOURCE/UNUSED/SYSOP10.TPU diff --git a/SYSOP11.TPU b/SOURCE/UNUSED/SYSOP11.TPU similarity index 100% rename from SYSOP11.TPU rename to SOURCE/UNUSED/SYSOP11.TPU diff --git a/SYSOP12.TPU b/SOURCE/UNUSED/SYSOP12.TPU similarity index 100% rename from SYSOP12.TPU rename to SOURCE/UNUSED/SYSOP12.TPU diff --git a/SYSOP2.TPU b/SOURCE/UNUSED/SYSOP2.TPU similarity index 100% rename from SYSOP2.TPU rename to SOURCE/UNUSED/SYSOP2.TPU diff --git a/SYSOP2A.TPU b/SOURCE/UNUSED/SYSOP2A.TPU similarity index 100% rename from SYSOP2A.TPU rename to SOURCE/UNUSED/SYSOP2A.TPU diff --git a/SYSOP2B.TPU b/SOURCE/UNUSED/SYSOP2B.TPU similarity index 100% rename from SYSOP2B.TPU rename to SOURCE/UNUSED/SYSOP2B.TPU diff --git a/SYSOP2C.TPU b/SOURCE/UNUSED/SYSOP2C.TPU similarity index 100% rename from SYSOP2C.TPU rename to SOURCE/UNUSED/SYSOP2C.TPU diff --git a/SYSOP2D.TPU b/SOURCE/UNUSED/SYSOP2D.TPU similarity index 100% rename from SYSOP2D.TPU rename to SOURCE/UNUSED/SYSOP2D.TPU diff --git a/SYSOP2E.TPU b/SOURCE/UNUSED/SYSOP2E.TPU similarity index 100% rename from SYSOP2E.TPU rename to SOURCE/UNUSED/SYSOP2E.TPU diff --git a/SYSOP2F.TPU b/SOURCE/UNUSED/SYSOP2F.TPU similarity index 100% rename from SYSOP2F.TPU rename to SOURCE/UNUSED/SYSOP2F.TPU diff --git a/SYSOP2G.TPU b/SOURCE/UNUSED/SYSOP2G.TPU similarity index 100% rename from SYSOP2G.TPU rename to SOURCE/UNUSED/SYSOP2G.TPU diff --git a/SYSOP2H.TPU b/SOURCE/UNUSED/SYSOP2H.TPU similarity index 100% rename from SYSOP2H.TPU rename to SOURCE/UNUSED/SYSOP2H.TPU diff --git a/SYSOP2I.TPU b/SOURCE/UNUSED/SYSOP2I.TPU similarity index 100% rename from SYSOP2I.TPU rename to SOURCE/UNUSED/SYSOP2I.TPU diff --git a/SYSOP2J.TPU b/SOURCE/UNUSED/SYSOP2J.TPU similarity index 100% rename from SYSOP2J.TPU rename to SOURCE/UNUSED/SYSOP2J.TPU diff --git a/SYSOP2K.TPU b/SOURCE/UNUSED/SYSOP2K.TPU similarity index 100% rename from SYSOP2K.TPU rename to SOURCE/UNUSED/SYSOP2K.TPU diff --git a/SYSOP2L.TPU b/SOURCE/UNUSED/SYSOP2L.TPU similarity index 100% rename from SYSOP2L.TPU rename to SOURCE/UNUSED/SYSOP2L.TPU diff --git a/SYSOP2M.TPU b/SOURCE/UNUSED/SYSOP2M.TPU similarity index 100% rename from SYSOP2M.TPU rename to SOURCE/UNUSED/SYSOP2M.TPU diff --git a/SYSOP2O.TPU b/SOURCE/UNUSED/SYSOP2O.TPU similarity index 100% rename from SYSOP2O.TPU rename to SOURCE/UNUSED/SYSOP2O.TPU diff --git a/SYSOP3.TPU b/SOURCE/UNUSED/SYSOP3.TPU similarity index 100% rename from SYSOP3.TPU rename to SOURCE/UNUSED/SYSOP3.TPU diff --git a/SYSOP4.TPU b/SOURCE/UNUSED/SYSOP4.TPU similarity index 100% rename from SYSOP4.TPU rename to SOURCE/UNUSED/SYSOP4.TPU diff --git a/SYSOP5.TPU b/SOURCE/UNUSED/SYSOP5.TPU similarity index 100% rename from SYSOP5.TPU rename to SOURCE/UNUSED/SYSOP5.TPU diff --git a/SYSOP6.TPU b/SOURCE/UNUSED/SYSOP6.TPU similarity index 100% rename from SYSOP6.TPU rename to SOURCE/UNUSED/SYSOP6.TPU diff --git a/SYSOP6~1.PAS b/SOURCE/UNUSED/SYSOP6~1.PAS similarity index 100% rename from SYSOP6~1.PAS rename to SOURCE/UNUSED/SYSOP6~1.PAS diff --git a/SYSOP7.TPU b/SOURCE/UNUSED/SYSOP7.TPU similarity index 100% rename from SYSOP7.TPU rename to SOURCE/UNUSED/SYSOP7.TPU diff --git a/SYSOP7M.TPU b/SOURCE/UNUSED/SYSOP7M.TPU similarity index 100% rename from SYSOP7M.TPU rename to SOURCE/UNUSED/SYSOP7M.TPU diff --git a/SYSOP8.TPU b/SOURCE/UNUSED/SYSOP8.TPU similarity index 100% rename from SYSOP8.TPU rename to SOURCE/UNUSED/SYSOP8.TPU diff --git a/SYSOP9.TPU b/SOURCE/UNUSED/SYSOP9.TPU similarity index 100% rename from SYSOP9.TPU rename to SOURCE/UNUSED/SYSOP9.TPU diff --git a/TAGLINE.DAT b/SOURCE/UNUSED/TAGLINE.DAT similarity index 100% rename from TAGLINE.DAT rename to SOURCE/UNUSED/TAGLINE.DAT diff --git a/TAGLINE.EXE b/SOURCE/UNUSED/TAGLINE.EXE similarity index 100% rename from TAGLINE.EXE rename to SOURCE/UNUSED/TAGLINE.EXE diff --git a/TAGLINE.PTR b/SOURCE/UNUSED/TAGLINE.PTR similarity index 100% rename from TAGLINE.PTR rename to SOURCE/UNUSED/TAGLINE.PTR diff --git a/TAGLINE.TXT b/SOURCE/UNUSED/TAGLINE.TXT similarity index 100% rename from TAGLINE.TXT rename to SOURCE/UNUSED/TAGLINE.TXT diff --git a/TAGSTAT.PAS b/SOURCE/UNUSED/TAGSTAT.PAS similarity index 100% rename from TAGSTAT.PAS rename to SOURCE/UNUSED/TAGSTAT.PAS diff --git a/TEMP6.BAT b/SOURCE/UNUSED/TEMP6.BAT similarity index 100% rename from TEMP6.BAT rename to SOURCE/UNUSED/TEMP6.BAT diff --git a/TIMEBANK.TPU b/SOURCE/UNUSED/TIMEBANK.TPU similarity index 100% rename from TIMEBANK.TPU rename to SOURCE/UNUSED/TIMEBANK.TPU diff --git a/TIMEFUNC.TPU b/SOURCE/UNUSED/TIMEFUNC.TPU similarity index 100% rename from TIMEFUNC.TPU rename to SOURCE/UNUSED/TIMEFUNC.TPU diff --git a/TPX.DSK b/SOURCE/UNUSED/TPX.DSK similarity index 100% rename from TPX.DSK rename to SOURCE/UNUSED/TPX.DSK diff --git a/TPX.TP b/SOURCE/UNUSED/TPX.TP similarity index 100% rename from TPX.TP rename to SOURCE/UNUSED/TPX.TP diff --git a/TURBO.DSK b/SOURCE/UNUSED/TURBO.DSK similarity index 100% rename from TURBO.DSK rename to SOURCE/UNUSED/TURBO.DSK diff --git a/USER.PAS b/SOURCE/UNUSED/USER.PAS similarity index 100% rename from USER.PAS rename to SOURCE/UNUSED/USER.PAS diff --git a/VOTE.TPU b/SOURCE/UNUSED/VOTE.TPU similarity index 100% rename from VOTE.TPU rename to SOURCE/UNUSED/VOTE.TPU diff --git a/WD110107.TXT b/SOURCE/UNUSED/WD110107.TXT similarity index 100% rename from WD110107.TXT rename to SOURCE/UNUSED/WD110107.TXT diff --git a/WD110207.TXT b/SOURCE/UNUSED/WD110207.TXT similarity index 100% rename from WD110207.TXT rename to SOURCE/UNUSED/WD110207.TXT diff --git a/WD110307.TXT b/SOURCE/UNUSED/WD110307.TXT similarity index 100% rename from WD110307.TXT rename to SOURCE/UNUSED/WD110307.TXT diff --git a/WFCMENU.TPU b/SOURCE/UNUSED/WFCMENU.TPU similarity index 100% rename from WFCMENU.TPU rename to SOURCE/UNUSED/WFCMENU.TPU diff --git a/WFCNEW1.ANS b/SOURCE/UNUSED/WFCNEW1.ANS similarity index 100% rename from WFCNEW1.ANS rename to SOURCE/UNUSED/WFCNEW1.ANS diff --git a/WFC_COM.ANS b/SOURCE/UNUSED/WFC_COM.ANS similarity index 100% rename from WFC_COM.ANS rename to SOURCE/UNUSED/WFC_COM.ANS diff --git a/WFC_NODE.ANS b/SOURCE/UNUSED/WFC_NODE.ANS similarity index 100% rename from WFC_NODE.ANS rename to SOURCE/UNUSED/WFC_NODE.ANS diff --git a/bootoldback.pas b/SOURCE/UNUSED/bootoldback.pas similarity index 100% rename from bootoldback.pas rename to SOURCE/UNUSED/bootoldback.pas diff --git a/SOURCE/UNUSED/m.cmd b/SOURCE/UNUSED/m.cmd new file mode 100644 index 0000000..89287c4 --- /dev/null +++ b/SOURCE/UNUSED/m.cmd @@ -0,0 +1 @@ +move %1.pas .. \ No newline at end of file diff --git a/VOTE.PAS b/SOURCE/VOTE.PAS similarity index 100% rename from VOTE.PAS rename to SOURCE/VOTE.PAS diff --git a/WFCMENU.PAS b/SOURCE/WFCMENU.PAS similarity index 100% rename from WFCMENU.PAS rename to SOURCE/WFCMENU.PAS diff --git a/SOURCE/WIN32/overlay.pas b/SOURCE/WIN32/overlay.pas new file mode 100644 index 0000000..eac3c90 --- /dev/null +++ b/SOURCE/WIN32/overlay.pas @@ -0,0 +1,9 @@ +unit overlay; + +// Dummy unit for Win32, so I don't have to IFDEF the USES OVERLAY out of dozens of files! + +interface + +implementation + +end. \ No newline at end of file diff --git a/SOURCE/crc32.obj b/SOURCE/crc32.obj new file mode 100644 index 0000000..e821fa5 Binary files /dev/null and b/SOURCE/crc32.obj differ diff --git a/SOURCE/execwin.obj b/SOURCE/execwin.obj new file mode 100644 index 0000000..0b70993 Binary files /dev/null and b/SOURCE/execwin.obj differ diff --git a/SOURCE/spawntp.obj b/SOURCE/spawntp.obj new file mode 100644 index 0000000..eb36f7b Binary files /dev/null and b/SOURCE/spawntp.obj differ diff --git a/VPC.CFG b/VPC.CFG new file mode 100644 index 0000000..c9350a5 --- /dev/null +++ b/VPC.CFG @@ -0,0 +1,25 @@ +/OZ:\PROGRA~1\RG119SRC\EXE\VP +/I.\ELECOM;Z:\VP21\SOURCE\RTL;Z:\VP21\SOURCE\TV +/U.\ELECOM;.\WIN32;Z:\VP21\UNITS.W32;Z:\VP21\SOURCE\RTL;Z:\VP21\SOURCE\W32;Z:\VP21\SOURCE\TV;Z:\VP21\EXAMPLES\W32\OPENGL\SHARED +/L.\ELECOM;Z:\VP21\LIB.W32;Z:\VP21\UNITS.W32 +/R.\ELECOM;Z:\VP21\RES.W32 +/$A+ +/$B- +/$D+ +/$E+ +/$F+ +/$G+ +/$I- +/$L+ +/$N- +/$O+ +/$P- +/$Q- +/$R- +/$S- +/$T- +/$V- +/$X+ +/$Y+ +/B +/GD