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..5dccab0 --- /dev/null +++ b/BUILDBP.CMD @@ -0,0 +1,48 @@ +@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 RGQUOTE.EXE +Z:\BP\BIN\BPC.EXE RGQUOTE.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..636c97e --- /dev/null +++ b/BUILDVP.CMD @@ -0,0 +1,48 @@ +@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 RGQUOTE.EXE +Z:\VP21\BIN.W32\VPC RGQUOTE.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..1844aac --- /dev/null +++ b/COPYEXEBP.CMD @@ -0,0 +1,7 @@ +@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\RGQUOTE.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..9c22858 --- /dev/null +++ b/COPYEXEVP.CMD @@ -0,0 +1,6 @@ +@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\RGQUOTE.EXE Z:\RG119\DATA\RGQUOTE32.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..b00c0df --- /dev/null +++ b/README.md @@ -0,0 +1,31 @@ +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 99% rename from ARCHIVE1.PAS rename to SOURCE/ARCHIVE1.PAS index 21e3579..94cf95d 100644 --- a/ARCHIVE1.PAS +++ b/SOURCE/ARCHIVE1.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Archive1; @@ -186,7 +190,7 @@ END; PROCEDURE ExtractToTemp; TYPE TotalsRecordType = RECORD - TotalFiles: Integer; + TotalFiles: SmallInt; TotalSize: LongInt; END; VAR diff --git a/ARCHIVE2.PAS b/SOURCE/ARCHIVE2.PAS similarity index 99% rename from ARCHIVE2.PAS rename to SOURCE/ARCHIVE2.PAS index d970d58..70b8d25 100644 --- a/ARCHIVE2.PAS +++ b/SOURCE/ARCHIVE2.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Archive2; diff --git a/ARCHIVE3.PAS b/SOURCE/ARCHIVE3.PAS similarity index 98% rename from ARCHIVE3.PAS rename to SOURCE/ARCHIVE3.PAS index 3870001..7c9d304 100644 --- a/ARCHIVE3.PAS +++ b/SOURCE/ARCHIVE3.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT Archive3; @@ -17,7 +21,7 @@ USES File11, TimeFunc; -PROCEDURE CvtFiles(FArea: Integer; FileName,ReZipCmd: AStr; VAR TotalFiles: Integer; VAR TotalOldSize,TotalNewSize: LongInt); +PROCEDURE CvtFiles(FArea: Integer; FileName,ReZipCmd: AStr; VAR TotalFiles: SmallInt; VAR TotalOldSize,TotalNewSize: LongInt); VAR S: AStr; DS: DirStr; @@ -157,7 +161,7 @@ END; PROCEDURE ReZipStuff; TYPE TotalsRecordType = RECORD - TotalFiles: Integer; + TotalFiles: SmallInt; TotalOldSize, TotalNewSize: LongInt END; diff --git a/ARCVIEW.PAS b/SOURCE/ARCVIEW.PAS similarity index 94% rename from ARCVIEW.PAS rename to SOURCE/ARCVIEW.PAS index f2be025..d02c5c6 100644 --- a/ARCVIEW.PAS +++ b/SOURCE/ARCVIEW.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT ArcView; @@ -48,23 +52,23 @@ TYPE ArcRecordType = RECORD {* structure of ARC archive file header *} FileName: ARRAY [0..12] OF Char; {* FileName *} C_Size: LongInt; {* compressed size *} - Mod_Date: Integer; {* last mod file Date *} - Mod_Time: Integer; {* last mod file Time *} - CRC: Integer; {* CRC *} + Mod_Date: SmallInt; {* last mod file Date *} + Mod_Time: SmallInt; {* last mod file Time *} + CRC: SmallInt; {* CRC *} U_Size: LongInt; {* uncompressed size *} END; ZipRecordType = RECORD {* structure of ZIP archive file header *} - Version: Integer; {* Version needed to extract *} - Bit_Flag: Integer; {* General purpose bit flag *} - Method: Integer; {* compression Method *} - Mod_Time: Integer; {* last mod file Time *} - Mod_Date: Integer; {* last mod file Date *} + Version: SmallInt; {* Version needed to extract *} + Bit_Flag: SmallInt; {* General purpose bit flag *} + Method: SmallInt; {* compression Method *} + Mod_Time: SmallInt; {* last mod file Time *} + Mod_Date: SmallInt; {* last mod file Date *} CRC: LongInt; {* CRC-32 *} C_Size: LongInt; {* compressed size *} U_Size: LongInt; {* uncompressed size *} - F_Length: Integer; {* FileName Length *} - E_Length: Integer; {* extra field Length *} + F_Length: SmallInt; {* FileName Length *} + E_Length: SmallInt; {* extra field Length *} END; ZooRecordType = RECORD {* structure of ZOO archive file header *} @@ -73,9 +77,9 @@ TYPE Method: Byte; {* 0 = Stored, 1 = Crunched *} Next: LongInt; {* position of Next directory entry *} Offset: LongInt; {* position of this file *} - Mod_Date: Word; {* modification Date (DOS format) *} - Mod_Time: Word; {* modification Time (DOS format) *} - CRC: Word; {* CRC *} + Mod_Date: SmallWord; {* modification Date (DOS format) *} + Mod_Time: SmallWord; {* modification Time (DOS format) *} + CRC: SmallWord; {* CRC *} U_Size: LongInt; {* uncompressed size *} C_Size: LongInt; {* compressed size *} Major_V: Char; {* major Version number *} @@ -83,11 +87,11 @@ TYPE Deleted: Byte; {* 0 = active, 1 = Deleted *} Struc: Char; {* file structure if any *} Comment: LongInt; {* location of file Comment (0 = none) *} - Cmt_Size: Word; {* Length of Comment (0 = none) *} + Cmt_Size: SmallWord; {* Length of Comment (0 = none) *} FName: ARRAY [0..12] OF Char; {* FileName *} - Var_DirLen: Integer; {* Length of variable part of dir entry *} + Var_DirLen: SmallInt; {* Length of variable part of dir entry *} TZ: Char; {* timezone where file was archived *} - Dir_Crc: Word; {* CRC of directory entry *} + Dir_Crc: SmallWord; {* CRC of directory entry *} END; LZHRecordType = RECORD {* structure of LZH archive file header *} @@ -96,11 +100,11 @@ TYPE Method: ARRAY [1..5] OF Char; {* compression TYPE "-lh#-" *} C_Size: LongInt; {* compressed size *} U_Size: LongInt; {* uncompressed size *} - Mod_Time: Integer;{* last mod file Time *} - Mod_Date: Integer;{* last mod file Date *} - Attrib: Integer; {* file attributes *} + Mod_Time: SmallInt;{* last mod file Time *} + Mod_Date: SmallInt;{* last mod file Date *} + Attrib: SmallInt; {* file attributes *} F_Length: Byte; {* Length of FileName *} - CRC: Integer; {* CRC *} + CRC: SmallInt; {* CRC *} END; ARJRecordType = RECORD @@ -113,20 +117,20 @@ TYPE FileType: Byte; GarbleMod: Byte; Time, - Date: Integer; + Date: SmallInt; CompSize: LongInt; OrigSize: LongInt; OrigCRC: ARRAY[1..4] OF Byte; - EntryName: Word; - AccessMode: Word; - HostData: Word; + EntryName: SmallWord; + AccessMode: SmallWord; + HostData: SmallWord; END; OutRec = RECORD {* output information structure *} FileName: AStr; {* output file name *} Date, {* output Date *} Time, {* output Time *} - Method: Integer; {* output storage type *} + Method: SmallInt; {* output storage type *} CSize, {* output compressed size *} USize: LongInt; {* output uncompressed size *} END; @@ -312,8 +316,8 @@ PROCEDURE ARJ_Proc(VAR ArjFile: FILE; VAR Aborted: Boolean); TYPE ARJSignature = RECORD - MagicNumber: Word; - BasicHdrSiz: Word; + MagicNumber: SmallWord; + BasicHdrSiz: SmallWord; END; VAR Hdr: ARJRecordType; diff --git a/AUTOMSG.PAS b/SOURCE/AUTOMSG.PAS similarity index 99% rename from AUTOMSG.PAS rename to SOURCE/AUTOMSG.PAS index f1a1eca..f53fe7c 100644 --- a/AUTOMSG.PAS +++ b/SOURCE/AUTOMSG.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT AutoMsg; diff --git a/BBSLIST.PAS b/SOURCE/BBSLIST.PAS similarity index 99% rename from BBSLIST.PAS rename to SOURCE/BBSLIST.PAS index 296daf3..b7e3920 100644 --- a/BBSLIST.PAS +++ b/SOURCE/BBSLIST.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT BBSList; diff --git a/BOOT.PAS b/SOURCE/BOOT.PAS similarity index 97% rename from BOOT.PAS rename to SOURCE/BOOT.PAS index 8d2984e..2d6d3be 100644 --- a/BOOT.PAS +++ b/SOURCE/BOOT.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Boot; @@ -813,12 +817,17 @@ FUNCTION SchareLoaded: Boolean; VAR T_Al: Byte; BEGIN +{$IFDEF MSDOS} ASM Mov Ah,10h Mov Al,0h Int 2fh Mov T_Al,Al END; +{$ENDIF} +{$IFDEF WIN32} + T_Al := $FF; +{$ENDIF} SchareLoaded := (T_Al = $FF); END; @@ -833,6 +842,7 @@ VAR WinOk, WinNTOk: Boolean; +{$IFDEF MSDOS} FUNCTION TrueDosVer(VAR WinNTOk: Boolean): Word; VAR Regs: Registers; @@ -848,7 +858,16 @@ VAR TrueDosVer := Bl; END; END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION TrueDosVer(VAR WinNTOk: Boolean): Word; + BEGIN + WinNtOK := TRUE; + TrueDosVer := 5; + END; +{$ENDIF} +{$IFDEF MSDOS} FUNCTION DosVer(VAR Minor,OS2Ver: Word): Word; VAR Regs: Registers; @@ -866,7 +885,17 @@ VAR OS2Ver := 2; END; END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION DosVer(VAR Minor,OS2Ver: Word): Word; + BEGIN + Minor := 0; + OS2Ver := 0; + DosVer := 5; + END; +{$ENDIF} +{$IFDEF MSDOS} FUNCTION Win3_Check_On: Boolean; VAR Regs: Registers; @@ -881,7 +910,15 @@ VAR Win3_Check_On := TRUE; END; END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION Win3_Check_On: Boolean; + BEGIN + Win3_Check_On := FALSE; + END; +{$ENDIF} +{$IFDEF MSDOS} FUNCTION DV_Check_On: Boolean; VAR Regs: Registers; @@ -899,6 +936,13 @@ VAR ELSE DV_Check_On := TRUE; END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION DV_Check_On: Boolean; + BEGIN + DV_Check_On := FALSE; + END; +{$ENDIF} BEGIN D5 := 0; diff --git a/BULLETIN.PAS b/SOURCE/BULLETIN.PAS similarity index 99% rename from BULLETIN.PAS rename to SOURCE/BULLETIN.PAS index 8f4e51d..7d91889 100644 --- a/BULLETIN.PAS +++ b/SOURCE/BULLETIN.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT Bulletin; diff --git a/COMMON.PAS b/SOURCE/COMMON.PAS similarity index 95% rename from COMMON.PAS rename to SOURCE/COMMON.PAS index 8462601..89966da 100644 --- a/COMMON.PAS +++ b/SOURCE/COMMON.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N+,O-,R-,S-,V-} UNIT Common; @@ -48,7 +52,7 @@ TYPE LightBarRecordType = RECORD XPos, YPos: Byte; - CmdToExec: Integer; + CmdToExec: SmallInt; CmdToShow: STRING[40]; END; @@ -95,7 +99,7 @@ TYPE BDLUserNum, BDLSection, BDLPoints, - BDLUploader: Integer; + BDLUploader: SmallInt; BDLFSize, BDLTime: LongInt; BDLFlags: TransferFlagSet; @@ -104,10 +108,10 @@ TYPE BatchULRecordType = RECORD BULFileName: Str12; BULUserNum, - BULSection: Integer; + BULSection: SmallInt; BULDescription: Str50; BULVPointer: LongInt; - BULVTextSize: Integer; + BULVTextSize: SmallInt; END; ExtendedDescriptionArray = ARRAY [1..99] OF Str50; @@ -157,7 +161,7 @@ TYPE ConferenceKeyType = SET OF '@'..'Z'; - CompArrayType = ARRAY[0..1] OF INTEGER; + CompArrayType = ARRAY[0..1] OF SMALLINT; CONST MCIBuffer: MCIBufferPtr = NIL; @@ -272,7 +276,9 @@ VAR DatFilePath: STRING[40]; Interrupt14: Pointer; { far ptr TO interrupt 14 } +{$IFDEF MSDOS} Ticks: LongInt ABSOLUTE $0040:$006C; +{$ENDIF} IEMSIRec: IEMSIRecord; FossilPort: Word; SockHandle: STRING; { Telnet Handle } @@ -460,6 +466,10 @@ VAR MQArea, VQArea: Boolean; +{$IFDEF WIN32} +procedure Sound(hz: Word; duration: Word); +function Ticks: LongInt; +{$ENDIF} FUNCTION GetC(c: Byte): STRING; PROCEDURE ShowColors; FUNCTION CheckDriveSpace(S,Path: AStr; MinSpace: Integer): Boolean; @@ -606,10 +616,10 @@ FUNCTION YN(Len: Byte; DYNY: Boolean): Boolean; FUNCTION PYNQ(CONST InString: AStr; MaxLen: Byte; DYNY: Boolean): Boolean; PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean); PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt); -PROCEDURE InputWordWC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); -PROCEDURE InputWordWOC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word); -PROCEDURE InputIntegerWC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); -PROCEDURE InputIntegerWOC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer); +PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); +PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word); +PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); +PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer); PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean); PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte); PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean); @@ -658,12 +668,103 @@ USES File11, Mail0, MultNode, +{$IFDEF MSDOS} SpawnO, +{$ENDIF} SysOp12, - Vote; + Vote +{$IFDEF WIN32} + ,VPSysLow + ,VPUtils + ,Windows +{$ENDIF} + ; +{$IFDEF WIN32} +procedure Sound(hz: Word; duration: Word); +begin + Windows.Beep(hz, duration); +end; + +function Ticks: LongInt; +begin + Ticks := GetTimeMSec div 55; +end; +{$ENDIF} + +{$IFDEF MSDOS} FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt; EXTERNAL; {$L CRC32.OBJ } +{$ENDIF} +{$IFDEF WIN32} +CONST + CRC_32_TAB : array[0..255] of LongInt = ( + $00000000, $77073096, $ee0e612c, $990951ba, $076dc419, + $706af48f, $e963a535, $9e6495a3, $0edb8832, $79dcb8a4, + $e0d5e91e, $97d2d988, $09b64c2b, $7eb17cbd, $e7b82d07, + $90bf1d91, $1db71064, $6ab020f2, $f3b97148, $84be41de, + $1adad47d, $6ddde4eb, $f4d4b551, $83d385c7, $136c9856, + $646ba8c0, $fd62f97a, $8a65c9ec, $14015c4f, $63066cd9, + $fa0f3d63, $8d080df5, $3b6e20c8, $4c69105e, $d56041e4, + $a2677172, $3c03e4d1, $4b04d447, $d20d85fd, $a50ab56b, + $35b5a8fa, $42b2986c, $dbbbc9d6, $acbcf940, $32d86ce3, + $45df5c75, $dcd60dcf, $abd13d59, $26d930ac, $51de003a, + $c8d75180, $bfd06116, $21b4f4b5, $56b3c423, $cfba9599, + $b8bda50f, $2802b89e, $5f058808, $c60cd9b2, $b10be924, + $2f6f7c87, $58684c11, $c1611dab, $b6662d3d, $76dc4190, + $01db7106, $98d220bc, $efd5102a, $71b18589, $06b6b51f, + $9fbfe4a5, $e8b8d433, $7807c9a2, $0f00f934, $9609a88e, + $e10e9818, $7f6a0dbb, $086d3d2d, $91646c97, $e6635c01, + $6b6b51f4, $1c6c6162, $856530d8, $f262004e, $6c0695ed, + $1b01a57b, $8208f4c1, $f50fc457, $65b0d9c6, $12b7e950, + $8bbeb8ea, $fcb9887c, $62dd1ddf, $15da2d49, $8cd37cf3, + $fbd44c65, $4db26158, $3ab551ce, $a3bc0074, $d4bb30e2, + $4adfa541, $3dd895d7, $a4d1c46d, $d3d6f4fb, $4369e96a, + $346ed9fc, $ad678846, $da60b8d0, $44042d73, $33031de5, + $aa0a4c5f, $dd0d7cc9, $5005713c, $270241aa, $be0b1010, + $c90c2086, $5768b525, $206f85b3, $b966d409, $ce61e49f, + $5edef90e, $29d9c998, $b0d09822, $c7d7a8b4, $59b33d17, + $2eb40d81, $b7bd5c3b, $c0ba6cad, $edb88320, $9abfb3b6, + $03b6e20c, $74b1d29a, $ead54739, $9dd277af, $04db2615, + $73dc1683, $e3630b12, $94643b84, $0d6d6a3e, $7a6a5aa8, + $e40ecf0b, $9309ff9d, $0a00ae27, $7d079eb1, $f00f9344, + $8708a3d2, $1e01f268, $6906c2fe, $f762575d, $806567cb, + $196c3671, $6e6b06e7, $fed41b76, $89d32be0, $10da7a5a, + $67dd4acc, $f9b9df6f, $8ebeeff9, $17b7be43, $60b08ed5, + $d6d6a3e8, $a1d1937e, $38d8c2c4, $4fdff252, $d1bb67f1, + $a6bc5767, $3fb506dd, $48b2364b, $d80d2bda, $af0a1b4c, + $36034af6, $41047a60, $df60efc3, $a867df55, $316e8eef, + $4669be79, $cb61b38c, $bc66831a, $256fd2a0, $5268e236, + $cc0c7795, $bb0b4703, $220216b9, $5505262f, $c5ba3bbe, + $b2bd0b28, $2bb45a92, $5cb36a04, $c2d7ffa7, $b5d0cf31, + $2cd99e8b, $5bdeae1d, $9b64c2b0, $ec63f226, $756aa39c, + $026d930a, $9c0906a9, $eb0e363f, $72076785, $05005713, + $95bf4a82, $e2b87a14, $7bb12bae, $0cb61b38, $92d28e9b, + $e5d5be0d, $7cdcefb7, $0bdbdf21, $86d3d2d4, $f1d4e242, + $68ddb3f8, $1fda836e, $81be16cd, $f6b9265b, $6fb077e1, + $18b74777, $88085ae6, $ff0f6a70, $66063bca, $11010b5c, + $8f659eff, $f862ae69, $616bffd3, $166ccf45, $a00ae278, + $d70dd2ee, $4e048354, $3903b3c2, $a7672661, $d06016f7, + $4969474d, $3e6e77db, $aed16a4a, $d9d65adc, $40df0b66, + $37d83bf0, $a9bcae53, $debb9ec5, $47b2cf7f, $30b5ffe9, + $bdbdf21c, $cabac28a, $53b39330, $24b4a3a6, $bad03605, + $cdd70693, $54de5729, $23d967bf, $b3667a2e, $c4614ab8, + $5d681b02, $2a6f2b94, $b40bbe37, $c30c8ea1, $5a05df1b, + $2d02ef8d); +FUNCTION UpdateCRC32(CRC: LongInt; VAR Buffer; Len: Word): LongInt; +VAR + i: Integer; + Octet: ^Byte; +BEGIN + Octet := @buffer; + for i := 1 to Len do + begin + CRC := CRC_32_TAB[Byte(Crc XOR LongInt(Octet^))] XOR ((Crc SHR 8) AND $00FFFFFF); + Inc(Octet); + end; + UpdateCRC32 := CRC; +END; +{$ENDIF} FUNCTION CheckPW: Boolean; BEGIN @@ -750,22 +851,22 @@ BEGIN Common3.InputLongIntWOC(S,L,InputFlags,LowNum,HighNum); END; -PROCEDURE InputWordWC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); +PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); BEGIN Common3.InputWordWC(S,W,InputFlags,LowNum,HighNum,Changed); END; -PROCEDURE InputWordWOC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word); +PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word); BEGIN Common3.InputWordWOC(S,W,InputFlags,LowNum,HighNum); END; -PROCEDURE InputIntegerWC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); +PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); BEGIN Common3.InputIntegerWC(S,I,InputFlags,LowNum,HighNum,Changed); END; -PROCEDURE InputIntegerWOC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer); +PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer); BEGIN Common3.InputIntegerWOC(S,I,Inputflags,LowNum,HighNum); END; @@ -2008,6 +2109,7 @@ BEGIN SwapVectors; +{$IFDEF MSDOS} IF (General.SwapShell) THEN BEGIN s := GetEnv('TEMP'); @@ -2016,6 +2118,10 @@ BEGIN Init_SpawNo(s,General.SwapTo,20,10); ResultCode := Spawn(GetEnv('COMSPEC'),FName,0); END; +{$ENDIF} +{$IFDEF WIN32} + ResultCode := -1; +{$ENDIF} IF (NOT General.SwapShell) OR (ResultCode = -1) THEN BEGIN @@ -2688,16 +2794,23 @@ CONST LastTimeSlice: LongInt = 0; LastCheckTimeSlice: LongInt = 0; VAR +{$IFDEF MSDOS} Killme: Pointer ABSOLUTE $0040 :$F000; +{$ENDIF} Tf: Boolean; I: Integer; C: Word; TempTimer: LongInt; BEGIN IF (DieLater) THEN +{$IFDEF MSDOS} ASM Call Killme END; +{$ENDIF} +{$IFDEF WIN32} + Halt; +{$ENDIF} LIL := 1; IF (Buf <> '') THEN BEGIN @@ -2737,11 +2850,17 @@ BEGIN BEGIN FOR I := 1 TO 100 DO BEGIN +{$IFDEF MSDOS} Sound(500 + (I * 10)); Delay(2); Sound(100 + (I * 10)); Delay(2); NoSound; +{$ENDIF} +{$IFDEF WIN32} + Sound(500, 200); + Sound(1500, 200); +{$ENDIF} END; LastBeep := TempTimer; END; @@ -2770,6 +2889,7 @@ BEGIN BEGIN IF (ABS((Ticks - LastTimeSlice)) >= General.Slicetimer) THEN BEGIN +{$IFDEF MSDOS} CASE Tasker OF None : ASM int 28h @@ -2792,6 +2912,10 @@ BEGIN Pop dx END; END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} LastTimeSlice := Ticks; END ELSE IF (MultiNodeChat) AND (NOT InChat) AND (ABS(Ticks - LastCheckTimeSlice) > 9) THEN @@ -2956,6 +3080,7 @@ BEGIN END; END; +{$IFDEF MSDOS} FUNCTION AOnOff(b: Boolean; CONST s1,s2:AStr): STRING; ASSEMBLER; ASM PUSH ds @@ -2974,6 +3099,16 @@ ASM REP MOVSB POP ds END; +{$ENDIF} +{$IFDEF WIN32} +FUNCTION AOnOff(b: Boolean; CONST s1,s2:AStr): STRING; +BEGIN + if (b) then + AOnOff := s1 + else + AOnOff := s2; +END; +{$ENDIF} FUNCTION ShowOnOff(b: Boolean): STRING; BEGIN @@ -3803,7 +3938,7 @@ FUNCTION MaxChatRec: LongInt; VAR DirInfo1: SearchRec; BEGIN - FindFirst(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP',0,DirInfo1); + FindFirst(General.TempPath+'MSG'+IntToStr(ThisNode)+'.TMP',AnyFile,DirInfo1); IF (DOSError = 0) THEN MaxChatRec := DirInfo1.Size ELSE @@ -3814,7 +3949,7 @@ FUNCTION MaxNodes: Byte; VAR DirInfo1: SearchRec; BEGIN - FindFirst(General.DataPath+'MULTNODE.DAT',0,DirInfo1); + FindFirst(General.DataPath+'MULTNODE.DAT',AnyFile,DirInfo1); IF (DOSError = 0) THEN MaxNodes := (DirInfo1.Size DIV SizeOf(NodeRecordType)) ELSE @@ -3909,7 +4044,7 @@ FUNCTION MaxUsers: Integer; VAR DirInfo1: SearchRec; BEGIN - FindFirst(General.DataPath+'USERS.DAT',0,DirInfo1); + FindFirst(General.DataPath+'USERS.DAT',AnyFile,DirInfo1); IF (DOSError = 0) THEN MaxUsers := (DirInfo1.Size DIV SizeOf(UserRecordType)) ELSE @@ -3920,7 +4055,7 @@ FUNCTION MaxIDXRec: Integer; VAR DirInfo1: SearchRec; BEGIN - FindFirst(General.DataPath+'USERS.IDX',0,DirInfo1); + FindFirst(General.DataPath+'USERS.IDX',AnyFile,DirInfo1); IF (DOSError = 0) THEN MaxIDXRec := (DirInfo1.Size DIV SizeOf(UserIDXRec)) ELSE @@ -3933,7 +4068,7 @@ FUNCTION HiMsg: Word; VAR DirInfo1: SearchRec; BEGIN - FindFirst(General.MsgPath+MemMsgArea.FileName+'.HDR',0,DirInfo1); + FindFirst(General.MsgPath+MemMsgArea.FileName+'.HDR',AnyFile,DirInfo1); IF (DOSError = 0) THEN HiMsg := (DirInfo1.Size DIV SizeOf(MHeaderRec)) ELSE @@ -4004,7 +4139,12 @@ BEGIN TempStr := ''; FOR XPos := 1 TO MaxDisplayCols DO BEGIN +{$IFDEF MSDOS} c := Chr(Mem[VidSeg:(160 * (YPos - 1) + 2 * (XPos - 1))]); +{$ENDIF} +{$IFDEF WIN32} + c := SysReadCharAt(XPos - 1, YPos - 1); +{$ENDIF} IF (c = #0) THEN c := #32; IF ((XPos = WhereX) AND (YPos = WhereY)) THEN @@ -4334,7 +4474,9 @@ BEGIN SaveCurCo := CurrentColor; SaveMCIAllowed := MCIAllowed; MCIAllowed := TRUE; +{$IFDEF MSDOS} NoSound; +{$ENDIF} IF (NOT AllowContinue) AND NOT (PrintingFile AND AllowAbort) THEN IsCont := FALSE; IF (IsCont) THEN @@ -4800,7 +4942,9 @@ END; FUNCTION DiskKBFree(DrivePath: AStr): LongInt; VAR F: TEXT; +{$IFDEF MSDOS} Regs: Registers; +{$ENDIF} S, S1: STRING; Counter: Integer; @@ -4839,6 +4983,7 @@ BEGIN END ELSE BEGIN +{$IFDEF MSDOS} FillChar(Regs,SizeOf(Regs),#0); Regs.Ah := $36; Regs.Dl := ExtractDriveNumber(DrivePath); @@ -4846,6 +4991,10 @@ BEGIN C := (1.0 * Regs.Ax); C1 := ((1.0 * Regs.Cx) * C); C2 := ((1.0 * Regs.Bx) * C1); +{$ENDIF} +{$IFDEF WIN32} + C2 := DiskFree(ExtractDriveNumber(DrivePath)); +{$ENDIF} END; DiskKBFree := Round(C2 / 1024.0); END; diff --git a/COMMON1.PAS b/SOURCE/COMMON1.PAS similarity index 99% rename from COMMON1.PAS rename to SOURCE/COMMON1.PAS index 28a0f03..845c220 100644 --- a/COMMON1.PAS +++ b/SOURCE/COMMON1.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} UNIT Common1; diff --git a/COMMON2.PAS b/SOURCE/COMMON2.PAS similarity index 97% rename from COMMON2.PAS rename to SOURCE/COMMON2.PAS index 2403d17..76f78f6 100644 --- a/COMMON2.PAS +++ b/SOURCE/COMMON2.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} UNIT Common2; @@ -25,7 +29,12 @@ USES LineChat, SysOp2G, SysOp3, - SplitCha; + SplitCha +{$IFDEF WIN32} + ,VPSysLow + ,Windows +{$ENDIF} + ; CONST SYSKEY_LENGTH = 1269; @@ -151,6 +160,7 @@ CONST 'H','o','u','r','s',':',#25,#6 ,'M','a','i','l',' ',':',#25,#6 ,'O', 'v','e','r','l','a','y','s',':',#25,#7 ,#24); +{$IFDEF MSDOS} PROCEDURE BiosScroll(up: Boolean); ASSEMBLER; ASM Mov cx,0 @@ -167,6 +177,19 @@ ASM @Go: Int 10h END; +{$ENDIF} +{$IFDEF WIN32} +PROCEDURE BiosScroll(up: Boolean); +BEGIN + if (up) then + begin + SysScrollUp(0, 0, MaxDisplayCols-1, MaxDisplayRows-1, 2, 7); + end else + begin + SysScrollDn(0, 0, MaxDisplayCols-1, MaxDisplayRows-1, 2, 7); + end; +END; +{$ENDIF} PROCEDURE CPR(c1,c2: Byte); VAR @@ -276,7 +299,12 @@ BEGIN CASE WhichScreen OF 1 : WITH ThisUser DO BEGIN +{$IFDEF MSDOS} Update_Logo(Win1,ScreenAddr[(FirstRow - 1) * 160],WIN1_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win1, 1, FirstRow, WIN1_LENGTH); +{$ENDIF} GoToXY(02,FirstRow); Write(Caps(Name)); GoToXY(33,FirstRow); @@ -321,7 +349,12 @@ BEGIN END; 2 : WITH ThisUser DO BEGIN +{$IFDEF MSDOS} Update_Logo(Win2,ScreenAddr[(FirstRow - 1) * 160],WIN2_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win2, 1, FirstRow, WIN2_LENGTH); +{$ENDIF} GoToXY(02,FirstRow); Write(Street); GoToXY(33,FirstRow); @@ -354,7 +387,12 @@ BEGIN END; 3 : WITH ThisUser DO BEGIN +{$IFDEF MSDOS} Update_Logo(Win3,ScreenAddr[(FirstRow - 1) * 160],WIN3_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win3, 1, FirstRow, WIN3_LENGTH); +{$ENDIF} GoToXY(06,FirstRow); Write(Loggedon); GoToXY(16,FirstRow); @@ -403,7 +441,12 @@ BEGIN Close(HistoryFile); WITH History DO BEGIN +{$IFDEF MSDOS} Update_Logo(Win4,ScreenAddr[(FirstRow - 1) * 160],WIN4_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win4, 1, FirstRow, WIN4_LENGTH); +{$ENDIF} GoToXY(20,FirstRow); Write(Callers); GoToXY(34,FirstRow); @@ -426,7 +469,12 @@ BEGIN END; 5 : WITH History DO BEGIN +{$IFDEF MSDOS} Update_Logo(Win5,ScreenAddr[(FirstRow - 1) * 160],WIN5_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(Win5, 1, FirstRow, WIN5_LENGTH); +{$ENDIF} GoToXY(20,FirstRow); Write(General.CallerNum); GoToXY(31,FirstRow); @@ -551,7 +599,12 @@ BEGIN CASE Ord(C) OF 119 : BEGIN { CTRL-HOME } SaveScreen(Wind); +{$IFDEF MSDOS} Update_Logo(SYSKEY,ScreenAddr[0],SYSKEY_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(SYSKEY, 1, 1, SYSKEY_LENGTH); +{$ENDIF} CursorOn(FALSE); C := ReadKey; IF (C = #0) THEN @@ -811,9 +864,14 @@ BEGIN REPEAT OutKey(^G); Delay(500); +{$IFDEF MSDOS} ASM Int 28h END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} CheckHangUp; UNTIL ((NOT Empty) OR (HangUp)); Update_Screen; diff --git a/COMMON3.PAS b/SOURCE/COMMON3.PAS similarity index 91% rename from COMMON3.PAS rename to SOURCE/COMMON3.PAS index d642d77..538f76c 100644 --- a/COMMON3.PAS +++ b/SOURCE/COMMON3.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-,X-} UNIT Common3; @@ -11,10 +15,10 @@ PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: Input PROCEDURE InputFormatted(DisplayStr: AStr; VAR InputStr: STRING; Format: STRING; Abortable: Boolean); PROCEDURE InputLongIntWC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt; VAR Changed: Boolean); PROCEDURE InputLongIntWOC(S: AStr; VAR L: LongInt; InputFlags: InputFlagSet; LowNum,HighNum: LongInt); -PROCEDURE InputWordWC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); -PROCEDURE InputWordWOC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word); -PROCEDURE InputIntegerWC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); -PROCEDURE InputIntegerWOC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer); +PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); +PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word); +PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); +PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer); PROCEDURE InputByteWC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte; VAR Changed: Boolean); PROCEDURE InputByteWOC(S: AStr; VAR B: Byte; InputFlags: InputFlagSet; LowNum,HighNum: Byte); PROCEDURE InputWN1(DisplayStr: AStr; VAR InputStr: AStr; MaxLen: Byte; InputFlags: InputFlagSet; VAR Changed: Boolean); @@ -28,7 +32,11 @@ PROCEDURE InputCaps(VAR S: STRING; MaxLen: Byte); IMPLEMENTATION USES - Crt; + Crt +{$IFDEF WIN32} + ,RPScreen +{$ENDIF} + ; PROCEDURE InputDefault(VAR S: STRING; v: STRING; MaxLen: Byte; InputFlags: InputFlagSet; LineFeed: Boolean); VAR @@ -161,7 +169,7 @@ BEGIN InputLongIntWC(S,L,InputFlags,LowNum,HighNum,Changed); END; -PROCEDURE InputWordWC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); +PROCEDURE InputWordWC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word; VAR Changed: Boolean); VAR TempStr: Str5; SaveW: Word; @@ -191,7 +199,7 @@ BEGIN Changed := TRUE; END; -PROCEDURE InputWordWOC(S: AStr; VAR W: Word; InputFlags: InputFlagSet; LowNum,HighNum: Word); +PROCEDURE InputWordWOC(S: AStr; VAR W: SmallWord; InputFlags: InputFlagSet; LowNum,HighNum: Word); VAR Changed: Boolean; BEGIN @@ -199,7 +207,7 @@ BEGIN InputWordWC(S,W,InputFlags,LowNum,HighNum,Changed); END; -PROCEDURE InputIntegerWC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); +PROCEDURE InputIntegerWC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer; VAR Changed: Boolean); VAR TempStr: Str5; SaveI: Integer; @@ -229,7 +237,7 @@ BEGIN Changed := TRUE; END; -PROCEDURE InputIntegerWOC(S: AStr; VAR I: Integer; InputFlags: InputFlagSet; LowNum,HighNum: Integer); +PROCEDURE InputIntegerWOC(S: AStr; VAR I: SmallInt; InputFlags: InputFlagSet; LowNum,HighNum: Integer); VAR Changed: Boolean; BEGIN @@ -336,6 +344,7 @@ VAR Inc(Cp); END; +{$IFDEF MSDOS} PROCEDURE SetCursor(InsertMode: Boolean); ASSEMBLER; ASM cmp InsertMode,0 @@ -350,6 +359,19 @@ VAR mov ah,1 int 10h END; +{$ENDIF} +{$IFDEF WIN32} + PROCEDURE SetCursor(InsertMode: Boolean); + BEGIN + if (InsertMode) then + begin + RPInsertCursor; + end else + begin + RPBlockCursor; + end; + END; +{$ENDIF} BEGIN FirstKey := FALSE; diff --git a/COMMON4.PAS b/SOURCE/COMMON4.PAS similarity index 87% rename from COMMON4.PAS rename to SOURCE/COMMON4.PAS index d001bf9..7abe0e2 100644 --- a/COMMON4.PAS +++ b/SOURCE/COMMON4.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} (* @@ -348,7 +352,17 @@ IMPLEMENTATION USES Crt, - Common; + Common +{$IFDEF WIN32} + ,EleNorm +{$ENDIF} + ; + +{$IFDEF WIN32} +VAR + DidClose: Boolean = false; + DidInit: Boolean = false; +{$ENDIF} (* AH = 0Ah Purge input buffer @@ -363,6 +377,7 @@ PROCEDURE Com_Flush_Recv; BEGIN IF (NOT LocalIOOnly) THEN BEGIN +{$IFDEF MSDOS} ASM Cmp InWfcMenu,1 Je @TheEnd @@ -371,6 +386,14 @@ BEGIN Int 14h @TheEnd: END; +{$ENDIF} +{$IFDEF WIN32} + if (InWfcMenu) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_PurgeInBuffer; // REENOTE Is this right? Function says flush not purge +{$ENDIF} END ELSE WHILE NOT (Com_IsRecv_Empty) DO WriteWFC(CInKey); @@ -395,6 +418,7 @@ the output buffer (not transmitted yet) is discarded. PROCEDURE Com_Purge_Send; BEGIN +{$IFDEF MSDOS} ASM Cmp LocalIOOnly,1 Je @TheEnd @@ -403,6 +427,14 @@ BEGIN Int 14h @TheEnd: END; +{$ENDIF} +{$IFDEF WIN32} + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_PurgeOutBuffer; +{$ENDIF} END; (* @@ -432,6 +464,7 @@ VAR Dummy: Byte; BEGIN Dummy := 0; (* New *) +{$IFDEF MSDOS} ASM Cmp LocalIOOnly,1 Je @TheEnd @@ -442,6 +475,14 @@ BEGIN @TheEnd: END; Com_Carrier := (Dummy AND $80) = $80; +{$ENDIF} +{$IFDEF WIN32} + Com_Carrier := false; + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + Com_Carrier := EleNorm.Com_Carrier; +{$ENDIF} END; (* @@ -471,9 +512,13 @@ CONST VAR Dummy: Byte; T_RecvChar: Boolean; +{$IFDEF WIN32} + Ch: Char; +{$ENDIF} BEGIN Com_Recv := #0; T_RecvChar := FALSE; +{$IFDEF MSDOS} ASM Cmp LocalIOOnly,1 Je @TheEnd @@ -491,6 +536,32 @@ BEGIN END; IF (T_RecvChar) THEN Com_Recv := Char(Dummy); +{$ENDIF} +{$IFDEF WIN32} + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + if Not(EleNorm.Com_CharAvail) then Exit; + + // Get character from buffer + Ch := EleNorm.Com_GetChar; + if (Ch = #10) then + begin + // Translate bare LF to CR + Com_Recv := #13; + end else + begin + Com_Recv := Ch; + end; + + // If this char is CR, check if the next char is LF (so we can discard it) + if (Ch = #13) and (EleNorm.Com_CharAvail) then + begin + Ch := EleNorm.Com_PeekChar; + if (Ch = #10) then EleNorm.Com_GetChar; // Discard that LF + end; +{$ENDIF} END; (* @@ -520,6 +591,7 @@ VAR Dummy: Byte; BEGIN Dummy := 0; (* New *) +{$IFDEF MSDOS} ASM Cmp LocalIOOnly,1 Je @TheEnd @@ -530,6 +602,15 @@ BEGIN @TheEnd: END; Com_IsRecv_Empty := NOT ((Dummy AND $01) = $01); +{$ENDIF} +{$IFDEF WIN32} + Com_IsRecv_Empty := true; + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + Com_IsRecv_Empty := Not(EleNorm.Com_CharAvail); +{$ENDIF} END; (* @@ -557,8 +638,12 @@ bit on hardwired (null modem) links. FUNCTION Com_IsSend_Empty: Boolean; VAR Dummy: Byte; +{$IFDEF WIN32} + InFree, OutFree, InUsed, OutUsed: LongInt; +{$ENDIF} BEGIN Dummy := 0; (* New *) +{$IFDEF MSDOS} ASM Cmp LocalIOOnly,1 Je @TheEnd @@ -569,6 +654,16 @@ BEGIN @TheEnd: END; Com_IsSend_Empty := ((Dummy AND $40) = $40); +{$ENDIF} +{$IFDEF WIN32} + Com_IsSend_Empty := false; + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_GetBufferStatus(InFree, OutFree, InUsed, OutUsed); + Com_IsSend_Empty := (OutUsed = 0); +{$ENDIF} END; (* @@ -585,6 +680,7 @@ value of 0000h is returned in AX. If the driver accepts the character PROCEDURE Com_Send(C: Char); BEGIN +{$IFDEF MSDOS} ASM Cmp LocalIOOnly,1 Je @TheEnd @@ -594,6 +690,14 @@ BEGIN Int 14h @TheEnd: END; +{$ENDIF} +{$IFDEF WIN32} + if (LocalIOOnly) then Exit; + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_SendChar(C); +{$ENDIF} END; (* @@ -669,12 +773,17 @@ BEGIN T_AL := 32; END; Inc(T_AL,3); +{$IFDEF MSDOS} ASM Mov AH,00h Mov AL,T_AL Mov DX,FossilPort Int 14h END; +{$ENDIF} +{$IFDEF WIN32} + // REENOTE Telnet can't set speed +{$ENDIF} END; END; @@ -692,16 +801,28 @@ PROCEDURE Com_DeInstall; BEGIN IF (NOT LocalIOOnly) THEN BEGIN +{$IFDEF MSDOS} ASM Mov AH,05h Mov DX,FossilPort Int 14h END; +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if Not(DidClose) then + begin + EleNorm.Com_Close; + DidClose := true; + end; + EleNorm.Com_ShutDown; +{$ENDIF} END; END; PROCEDURE Com_Install; +{$IFDEF MSDOS} FUNCTION DriverInstalled: Word; ASSEMBLER; ASM Mov AH,5 @@ -712,11 +833,19 @@ PROCEDURE Com_Install; PushF Call Interrupt14 END; +{$ENDIF} +{$IFDEF WIN32} + FUNCTION DriverInstalled: Word; + BEGIN + // REENOTE Never gets called in Win32 + END; +{$ENDIF} BEGIN FossilPort := (Liner.Comport - 1); IF (LocalIOOnly) THEN Exit; +{$IFDEF MSDOS} IF (DriverInstalled <> $1954) THEN BEGIN ClrScr; @@ -740,9 +869,19 @@ BEGIN PushF Call Interrupt14 END; +{$ENDIF} +{$IFDEF WIN32} + if (DidInit) then Exit; + if (DidClose) then Exit; + DidInit := true; + EleNorm.Com_StartUp(2); + EleNorm.Com_SetDontClose(false); + EleNorm.Com_OpenQuick(answerbaud); // REENOTE Should come up with a better solution, this works for now though +{$ENDIF} Com_Set_Speed(Liner.InitBaud); END; +{$IFDEF MSDOS} PROCEDURE CheckHangup; ASSEMBLER; ASM Cmp LocalIOOnly,1 @@ -758,6 +897,20 @@ ASM Mov HangUp,1 @GetOut: END; +{$ENDIF} +{$IFDEF WIN32} +PROCEDURE CheckHangup; +BEGIN + if (LocalIOOnly) then Exit; + if Not(OutCom) then Exit; + + if Not(Com_Carrier) then + begin + HangUp := true; + HungUp := true; + end; +END; +{$ENDIF} (* AH = 19h Write block (transfer from user buffer to FOSSIL) @@ -782,6 +935,7 @@ VAR BEGIN IF (OutCom) THEN BEGIN +{$IFDEF MSDOS} REPEAT T_DI := OFS(S[1]); T_CX := Length(S); @@ -798,6 +952,13 @@ BEGIN Move(S[T_AX + 1],S[1],Length(S) - T_AX); Dec(S[0],T_AX); UNTIL (S = ''); +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + EleNorm.Com_SendString(S); +{$ENDIF} END; END; @@ -830,6 +991,7 @@ BEGIN Empty := NOT KeyPressed; IF (InCom) AND (NOT KeyPressed) THEN BEGIN +{$IFDEF MSDOS} ASM Mov DX,FossilPort Mov AH,03h @@ -837,6 +999,13 @@ BEGIN Mov T_AH,AH END; Empty := NOT (T_AH AND 1 = 1); +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + Empty := Not(EleNorm.Com_CharAvail); +{$ENDIF} END; END; @@ -858,12 +1027,24 @@ BEGIN IF (NOT LocalIOOnly) THEN BEGIN T_AL := Byte(Status); +{$IFDEF MSDOS} ASM Mov AH,06h Mov DX,FossilPort Mov AL,T_AL Int 14h END; +{$ENDIF} +{$IFDEF WIN32} + if Not(DidInit) then Exit; + if (DidClose) then Exit; + if Not(EleNorm.Com_Carrier) then Exit; + if Not(Status) then + begin + EleNorm.Com_Close; + DidClose := true; + end; +{$ENDIF} END; END; diff --git a/COMMON5.PAS b/SOURCE/COMMON5.PAS similarity index 99% rename from COMMON5.PAS rename to SOURCE/COMMON5.PAS index 43bb2a2..2126279 100644 --- a/COMMON5.PAS +++ b/SOURCE/COMMON5.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} UNIT Common5; diff --git a/CUSER.PAS b/SOURCE/CUSER.PAS similarity index 99% rename from CUSER.PAS rename to SOURCE/CUSER.PAS index 1054dda..a7f1ab4 100644 --- a/CUSER.PAS +++ b/SOURCE/CUSER.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT CUser; @@ -892,7 +896,7 @@ VAR VAR AScheme: SchemeRec; i, - Onlin: Integer; + Onlin: SmallInt; BEGIN Reset(SchemeFile); CLS; diff --git a/DOORS.PAS b/SOURCE/DOORS.PAS similarity index 99% rename from DOORS.PAS rename to SOURCE/DOORS.PAS index 47bf516..cade80b 100644 --- a/DOORS.PAS +++ b/SOURCE/DOORS.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Doors; 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 99% rename from EMAIL.PAS rename to SOURCE/EMAIL.PAS index 7abd34f..0d835ec 100644 --- a/EMAIL.PAS +++ b/SOURCE/EMAIL.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT EMail; @@ -667,7 +671,7 @@ END; PROCEDURE ReadMail; TYPE - MessageArrayType = ARRAY [1..255] OF Word; + MessageArrayType = ARRAY [1..255] OF SmallWord; VAR MessageArray: MessageArrayType; User: UserRecordType; diff --git a/EVENTS.PAS b/SOURCE/EVENTS.PAS similarity index 96% rename from EVENTS.PAS rename to SOURCE/EVENTS.PAS index 09c6223..24ed03e 100644 --- a/EVENTS.PAS +++ b/SOURCE/EVENTS.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Events; @@ -15,7 +19,11 @@ IMPLEMENTATION USES Dos, Common, - TimeFunc; + TimeFunc +{$IFDEF WIN32} + ,Windows +{$ENDIF} + ; FUNCTION InTime(Tim,Tim1,Tim2: LongInt): Boolean; BEGIN @@ -222,11 +230,19 @@ END; FUNCTION SysOpAvailable: Boolean; VAR +{$IFDEF MSDOS} A: Byte ABSOLUTE $0000:$0417; +{$ENDIF} EventNum: Integer; ChatOk: Boolean; BEGIN +{$IFDEF MSDOS} ChatOk := ((A AND 16) = 0); +{$ENDIF} +{$IFDEF WIN32} + // Availability is togged with scroll lock key + ChatOk := (GetKeyState($91) and $ffff) <> 0; +{$ENDIF} IF (RChat IN ThisUser.Flags) THEN ChatOk := FALSE; diff --git a/EXECBAT.PAS b/SOURCE/EXECBAT.PAS similarity index 97% rename from EXECBAT.PAS rename to SOURCE/EXECBAT.PAS index 7579913..fa586db 100644 --- a/EXECBAT.PAS +++ b/SOURCE/EXECBAT.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT ExecBat; @@ -39,10 +43,12 @@ VAR SaveY: Byte; SavCurWind: Integer; +{$IFDEF MSDOS} {$L EXECWIN} PROCEDURE SetCsInts; EXTERNAL; PROCEDURE NewInt21; EXTERNAL; +{$ENDIF} PROCEDURE ExecWindow(VAR Ok: Boolean; CONST Dir, @@ -79,6 +85,7 @@ BEGIN WindLo := WindMin; WindHi := WindMax; +{$IFDEF MSDOS} {Assure cursor is in Window} INLINE ( @@ -115,6 +122,7 @@ BEGIN GetIntVec($21,CurInt21); SetCsInts; SetIntVec($21,@NewInt21); +{$ENDIF} {$IFDEF Ver70} {Prevent SwapVectors from undoing our int21 change} @@ -132,8 +140,10 @@ BEGIN Window(1,1,MaxDisplayCols,MaxDisplayRows); RemoveWindow(Wind); +{$IFDEF MSDOS} {Restore interrupt} SetIntVec($21,CurInt21); +{$ENDIF} General.CurWindow := SaveCurWindow; General.WindowOn := SaveWindowOn; LastScreenSwap := (Timer - 5); diff --git a/FILE0.PAS b/SOURCE/FILE0.PAS similarity index 99% rename from FILE0.PAS rename to SOURCE/FILE0.PAS index bd2c6ee..2487204 100644 --- a/FILE0.PAS +++ b/SOURCE/FILE0.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File0; @@ -37,7 +41,11 @@ USES Dos, File1, ShortMsg, - TimeFunc; + TimeFunc +{$IFDEF WIN32} + ,Windows +{$ENDIF} + ; FUNCTION CompFileArea(FArea,ArrayNum: Integer): Integer; VAR @@ -581,9 +589,14 @@ BEGIN SaveTimer := Timer; END ELSE +{$IFDEF MSDOS} ASM Int 28h END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} END; IF (Cmd <> #27) THEN BEGIN diff --git a/FILE1.PAS b/SOURCE/FILE1.PAS similarity index 99% rename from FILE1.PAS rename to SOURCE/FILE1.PAS index 40fb151..473e66d 100644 --- a/FILE1.PAS +++ b/SOURCE/FILE1.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File1; diff --git a/FILE10.PAS b/SOURCE/FILE10.PAS similarity index 99% rename from FILE10.PAS rename to SOURCE/FILE10.PAS index 7a1ec3f..916a0e0 100644 --- a/FILE10.PAS +++ b/SOURCE/FILE10.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File10; diff --git a/FILE11.PAS b/SOURCE/FILE11.PAS similarity index 99% rename from FILE11.PAS rename to SOURCE/FILE11.PAS index fe87a7e..43e08b0 100644 --- a/FILE11.PAS +++ b/SOURCE/FILE11.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File11; @@ -10,7 +14,7 @@ USES TYPE FileRecType = RECORD FArrayFileArea, - FArrayDirFileRecNum: Integer; + FArrayDirFileRecNum: SmallInt; END; FileArrayType = ARRAY [0..99] OF FileRecType; @@ -46,7 +50,7 @@ USES TimeFunc; TYPE - DownLoadArrayType = ARRAY [0..99] OF Integer; + DownLoadArrayType = ARRAY [0..99] OF SmallInt; VAR DLArray: DownloadArrayType; diff --git a/FILE12.PAS b/SOURCE/FILE12.PAS similarity index 99% rename from FILE12.PAS rename to SOURCE/FILE12.PAS index fbf6591..85009d5 100644 --- a/FILE12.PAS +++ b/SOURCE/FILE12.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File12; diff --git a/FILE13.PAS b/SOURCE/FILE13.PAS similarity index 98% rename from FILE13.PAS rename to SOURCE/FILE13.PAS index 024e009..afb2f13 100644 --- a/FILE13.PAS +++ b/SOURCE/FILE13.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File13; diff --git a/FILE14.PAS b/SOURCE/FILE14.PAS similarity index 99% rename from FILE14.PAS rename to SOURCE/FILE14.PAS index 1c6cfe7..4f383df 100644 --- a/FILE14.PAS +++ b/SOURCE/FILE14.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File14; diff --git a/FILE2.PAS b/SOURCE/FILE2.PAS similarity index 98% rename from FILE2.PAS rename to SOURCE/FILE2.PAS index cf1adaa..3d2d1ef 100644 --- a/FILE2.PAS +++ b/SOURCE/FILE2.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File2; diff --git a/FILE3.PAS b/SOURCE/FILE3.PAS similarity index 98% rename from FILE3.PAS rename to SOURCE/FILE3.PAS index ef6d126..b456986 100644 --- a/FILE3.PAS +++ b/SOURCE/FILE3.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File3; diff --git a/FILE4.PAS b/SOURCE/FILE4.PAS similarity index 99% rename from FILE4.PAS rename to SOURCE/FILE4.PAS index e4991d1..7f84b2a 100644 --- a/FILE4.PAS +++ b/SOURCE/FILE4.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File4; diff --git a/FILE5.PAS b/SOURCE/FILE5.PAS similarity index 99% rename from FILE5.PAS rename to SOURCE/FILE5.PAS index 9486d9a..6ded087 100644 --- a/FILE5.PAS +++ b/SOURCE/FILE5.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File5; diff --git a/FILE6.PAS b/SOURCE/FILE6.PAS similarity index 99% rename from FILE6.PAS rename to SOURCE/FILE6.PAS index d674cf3..15ef0b2 100644 --- a/FILE6.PAS +++ b/SOURCE/FILE6.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File6; diff --git a/FILE7.PAS b/SOURCE/FILE7.PAS similarity index 99% rename from FILE7.PAS rename to SOURCE/FILE7.PAS index 837c985..b2ea1b3 100644 --- a/FILE7.PAS +++ b/SOURCE/FILE7.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File7; diff --git a/FILE8.PAS b/SOURCE/FILE8.PAS similarity index 99% rename from FILE8.PAS rename to SOURCE/FILE8.PAS index 8781760..818404b 100644 --- a/FILE8.PAS +++ b/SOURCE/FILE8.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File8; diff --git a/FILE9.PAS b/SOURCE/FILE9.PAS similarity index 99% rename from FILE9.PAS rename to SOURCE/FILE9.PAS index fc45793..beeeac2 100644 --- a/FILE9.PAS +++ b/SOURCE/FILE9.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT File9; diff --git a/LINECHAT.PAS b/SOURCE/LINECHAT.PAS similarity index 96% rename from LINECHAT.PAS rename to SOURCE/LINECHAT.PAS index 79b06ce..0a4e0a3 100644 --- a/LINECHAT.PAS +++ b/SOURCE/LINECHAT.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT LineChat; @@ -70,6 +74,7 @@ BEGIN Delay(600) ELSE BEGIN +{$IFDEF MSDOS} FOR Counter1 := 300 DOWNTO 2 DO BEGIN Delay(1); @@ -80,8 +85,14 @@ BEGIN Delay(1); Sound(Counter1 * 10); END; + NoSound; +{$ENDIF} +{$IFDEF WIN32} + Sound(3000, 200); + Sound(1000, 200); + Sound(3000, 200); +{$ENDIF} END; - NoSound; IF (KeyPressed) THEN BEGIN Cmd := ReadKey; @@ -360,6 +371,7 @@ BEGIN CLS ELSE IF (S = '/PAGE') THEN BEGIN +{$IFDEF MSDOS} FOR Counter := 650 TO 700 DO BEGIN Sound(Counter); @@ -372,6 +384,15 @@ BEGIN Delay(2); NoSound; UNTIL (Counter = 200); +{$ENDIF} +{$IFDEF WIN32} + Sound(650, 200); + Sound(700, 200); + Sound(600, 200); + Sound(500, 200); + Sound(400, 200); + Sound(300, 200); +{$ENDIF} Prompt(^G^G); END ELSE IF (S = '/BYE') THEN diff --git a/LOGON.PAS b/SOURCE/LOGON.PAS similarity index 99% rename from LOGON.PAS rename to SOURCE/LOGON.PAS index 4383c8f..ce529f7 100644 --- a/LOGON.PAS +++ b/SOURCE/LOGON.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Logon; @@ -740,7 +744,7 @@ VAR S, ACSReq: AStr; OverridePW: Str20; - Lng: Integer; + Lng: SmallInt; Tries, I, TTimes, diff --git a/MAIL0.PAS b/SOURCE/MAIL0.PAS similarity index 99% rename from MAIL0.PAS rename to SOURCE/MAIL0.PAS index cb9fab0..788e826 100644 --- a/MAIL0.PAS +++ b/SOURCE/MAIL0.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Mail0; diff --git a/MAIL1.PAS b/SOURCE/MAIL1.PAS similarity index 99% rename from MAIL1.PAS rename to SOURCE/MAIL1.PAS index 6c8a863..0584a25 100644 --- a/MAIL1.PAS +++ b/SOURCE/MAIL1.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Mail1; @@ -1219,7 +1223,7 @@ VAR Insert_Char(Char(GKey)); 127 : Delete_Char; - 32..254 : + 32..46, 48..126, 128..254 : Insert_Char(Char(GKey)); 8 : BEGIN IF (CCol = 1) THEN @@ -1334,7 +1338,7 @@ VAR HelpCounter: Byte; Counter, LineNum1, - LineNum2: Integer; + LineNum2: SmallInt; ShowCont, ExitMsg, SaveLine, diff --git a/MAIL2.PAS b/SOURCE/MAIL2.PAS similarity index 99% rename from MAIL2.PAS rename to SOURCE/MAIL2.PAS index c4320ea..f45e300 100644 --- a/MAIL2.PAS +++ b/SOURCE/MAIL2.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Mail2; diff --git a/MAIL3.PAS b/SOURCE/MAIL3.PAS similarity index 99% rename from MAIL3.PAS rename to SOURCE/MAIL3.PAS index cac107d..299c1bc 100644 --- a/MAIL3.PAS +++ b/SOURCE/MAIL3.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Mail3; diff --git a/MAIL4.PAS b/SOURCE/MAIL4.PAS similarity index 99% rename from MAIL4.PAS rename to SOURCE/MAIL4.PAS index 74e325f..6203d12 100644 --- a/MAIL4.PAS +++ b/SOURCE/MAIL4.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Mail4; diff --git a/MAINT.PAS b/SOURCE/MAINT.PAS similarity index 99% rename from MAINT.PAS rename to SOURCE/MAINT.PAS index dabb1e0..69cbd4c 100644 --- a/MAINT.PAS +++ b/SOURCE/MAINT.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Maint; diff --git a/MENUS.PAS b/SOURCE/MENUS.PAS similarity index 99% rename from MENUS.PAS rename to SOURCE/MENUS.PAS index c5060b6..3ef36fd 100644 --- a/MENUS.PAS +++ b/SOURCE/MENUS.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O-,R-,S+,V-} UNIT Menus; diff --git a/MENUS2.PAS b/SOURCE/MENUS2.PAS similarity index 99% rename from MENUS2.PAS rename to SOURCE/MENUS2.PAS index 299e4bf..4b483f4 100644 --- a/MENUS2.PAS +++ b/SOURCE/MENUS2.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Menus2; diff --git a/MENUS3.PAS b/SOURCE/MENUS3.PAS similarity index 98% rename from MENUS3.PAS rename to SOURCE/MENUS3.PAS index a020430..e2f22c5 100644 --- a/MENUS3.PAS +++ b/SOURCE/MENUS3.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT Menus3; diff --git a/MISCUSER.PAS b/SOURCE/MISCUSER.PAS similarity index 99% rename from MISCUSER.PAS rename to SOURCE/MISCUSER.PAS index e51592b..bc6ca04 100644 --- a/MISCUSER.PAS +++ b/SOURCE/MISCUSER.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT MiscUser; diff --git a/MSGPACK.PAS b/SOURCE/MSGPACK.PAS similarity index 99% rename from MSGPACK.PAS rename to SOURCE/MSGPACK.PAS index bc8d019..8652eaf 100644 --- a/MSGPACK.PAS +++ b/SOURCE/MSGPACK.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT MsgPack; diff --git a/MULTNODE.PAS b/SOURCE/MULTNODE.PAS similarity index 99% rename from MULTNODE.PAS rename to SOURCE/MULTNODE.PAS index 93187db..e64a6a4 100644 --- a/MULTNODE.PAS +++ b/SOURCE/MULTNODE.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT Multnode; diff --git a/MYIO.PAS b/SOURCE/MYIO.PAS similarity index 86% rename from MYIO.PAS rename to SOURCE/MYIO.PAS index eb7b47b..71e471b 100644 --- a/MYIO.PAS +++ b/SOURCE/MYIO.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R+,S-,V-} UNIT MyIO; @@ -24,8 +28,13 @@ CONST VAR Wind: WindowRec; +{$IFDEF MSDOS} MonitorType: Byte ABSOLUTE $0000:$0449; ScreenAddr: ScreenType ABSOLUTE $B800:$0000; +{$ENDIF} +{$IFDEF WIN32} + MonitorType: Byte = 3; // REENOTE 3=CO80, a safe assumption I think +{$ENDIF} ScreenSize: Integer; MaxDisplayRows, MaxDisplayCols, @@ -41,7 +50,12 @@ VAR Infield_Arrow_Exit_Types, Infield_Normal_Exit_Keys: STRING; +{$IFDEF MSDOS} PROCEDURE Update_Logo(VAR Addr1,Addr2; BlkLen: Integer); +{$ENDIF} +{$IFDEF WIN32} +procedure Update_Logo(Data: Array of Char; OriginX, OriginY, DataLength: integer); +{$ENDIF} PROCEDURE CursorOn(b: BOOLEAN); PROCEDURE infield1(x,y: Byte; VAR s: AStr; Len: Byte); PROCEDURE Infielde(VAR s: AStr; Len: Byte); @@ -60,8 +74,19 @@ PROCEDURE SetWindow(VAR Wind: WindowRec; TLX,TLY,BRX,BRY,TColr,BColr,BoxType: In IMPLEMENTATION USES - Crt; + Crt +{$IFDEF WIN32} + ,RPScreen + ,VpSysLow +{$ENDIF} + ; +{$IFDEF WIN32} +VAR + SavedScreen: TScreenBuf; +{$ENDIF} + +{$IFDEF MSDOS} PROCEDURE CursorOn(b: BOOLEAN); ASSEMBLER; ASM cmp b, 1 @@ -76,6 +101,19 @@ ASM mov ah,1 int 10h END; +{$ENDIF} +{$IFDEF WIN32} +PROCEDURE CursorOn(b: BOOLEAN); +BEGIN + if (b) then + begin + RPShowCursor; + end else + begin + RPHideCursor; + end; +END; +{$ENDIF} PROCEDURE infield1(x,y: Byte; VAR s: AStr; Len: Byte); VAR @@ -525,12 +563,22 @@ END; PROCEDURE SaveScreen(VAR Wind: WindowRec); BEGIN +{$IFDEF MSDOS} Move(ScreenAddr[0],Wind[0],ScreenSize); +{$ENDIF} +{$IFDEF WIN32} + RPSaveScreen(SavedScreen); +{$ENDIF} END; PROCEDURE RemoveWindow(VAR Wind: WindowRec); BEGIN +{$IFDEF MSDOS} Move(Wind[0],ScreenAddr[0],ScreenSize); +{$ENDIF} +{$IFDEF WIN32} + RPRestoreScreen(SavedScreen); +{$ENDIF} END; PROCEDURE SetWindow(VAR Wind: WindowRec; TLX,TLY,BRX,BRY,TColr,BColr,BoxType:Integer); @@ -543,6 +591,7 @@ BEGIN Box(BoxType,TLX,TLY,BRX,BRY); { Set the border } END; +{$IFDEF MSDOS} PROCEDURE Update_Logo(VAR Addr1,Addr2; BlkLen: Integer); BEGIN INLINE ( @@ -600,5 +649,60 @@ BEGIN $E0/$AA/ $1F); END; +{$ENDIF} +{$IFDEF WIN32} +procedure Update_Logo(Data: Array of Char; OriginX, OriginY, DataLength: integer); +var + i, x, y, count, counter: Integer; + character: Char; + spaces: String; +begin + i := 0; + x := OriginX; + y := OriginY; + spaces := ' '; // 80 spaces + + while (i < DataLength) do + begin + case Data[i] of + #0..#15: begin + TextColor(Ord(Data[i])); + end; + #16..#23: begin + TextBackground(Ord(Data[i]) - 16); + end; + #24: begin + x := OriginX; + Inc(y); + end; + #25: begin + Inc(i); + count := Ord(Data[i])+1; + SysWrtCharStrAtt(@spaces[1], count, x-1, y-1, TextAttr); + Inc(x, count); + end; + #26: begin + Inc(i); + count := Ord(Data[i])+1; + Inc(i); + character := Data[i]; + for counter := 1 to count do + begin + SysWrtCharStrAtt(@Data[i], 1, x-1, y-1, TextAttr); + Inc(x); + end; + end; + #27: begin + TextAttr := TextAttr XOR $80; // Invert blink flag + end; + #32..#255: begin + SysWrtCharStrAtt(@Data[i], 1, x-1, y-1, TextAttr); + Inc(x); + end; + end; + Inc(i); + end; +end; +{$ENDIF} END. diff --git a/NEWUSERS.PAS b/SOURCE/NEWUSERS.PAS similarity index 99% rename from NEWUSERS.PAS rename to SOURCE/NEWUSERS.PAS index ed222f3..d9b0313 100644 --- a/NEWUSERS.PAS +++ b/SOURCE/NEWUSERS.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT NewUsers; diff --git a/NODELIST.PAS b/SOURCE/NODELIST.PAS similarity index 94% rename from NODELIST.PAS rename to SOURCE/NODELIST.PAS index b9bbaad..684380e 100644 --- a/NODELIST.PAS +++ b/SOURCE/NODELIST.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT Nodelist; @@ -9,8 +13,8 @@ USES PROCEDURE ToggleNetAttr(NetAttrT: NetAttr; VAR NetAttrS: NetAttribs); PROCEDURE ToggleNetAttrs(C: CHAR; VAR NetAttrS: NetAttribs); -FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: Word): Boolean; -PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point,Fee: Word; GetFee: Boolean); +FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: SmallWord): Boolean; +PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point: SmallWord; var Fee: Word; GetFee: Boolean); PROCEDURE ChangeFlags(VAR MsgHeader: MHeaderRec); FUNCTION NetMail_Attr(NetAttribute: NetAttribs): AStr; @@ -26,10 +30,10 @@ TYPE Zone, { Zone of board } Net, { Net Address of board } Node, { Node Address of board } - Point: Integer; { Either Point number OR 0 } + Point: SmallInt; { Either Point number OR 0 } CallCost, { Cost to sysop to send } MsgFee, { Cost to user to send } - NodeFlags: Word; { Node flags } + NodeFlags: SmallWord; { Node flags } ModemType, { Modem TYPE } PassWord: STRING[9]; Phone, @@ -42,34 +46,34 @@ TYPE IndxRefBlk = RECORD IndxOfs, { Offset of STRING into block } - IndxLen: Word; { Length of STRING } + IndxLen: SmallWord; { Length of STRING } IndxData, { RECORD number of STRING } IndxPtr: LongInt; { Block number of lower index } END; { IndxRef } LeafRefBlk = RECORD KeyOfs, { Offset of STRING into block } - KeyLen: Word; { Length of STRING } + KeyLen: SmallWord; { Length of STRING } KeyVal: LongInt; { Pointer to Data block } END; { LeafRef } CtlBlk = RECORD - CtlBlkSize: Word; { blocksize of Index blocks } + CtlBlkSize: SmallWord; { blocksize of Index blocks } CtlRoot, { Block number of Root } CtlHiBlk, { Block number of last block } CtlLoLeaf, { Block number of first leaf } CtlHiLeaf, { Block number of last leaf } CtlFree: LongInt; { Head of freelist } CtlLvls, { Number of index levels } - CtlParity: Word; { XOR of above fields } + CtlParity: SmallWord; { XOR of above fields } END; INodeBlk = RECORD IndxFirst, { Pointer to next lower level } IndxBLink, { Pointer to previous link } IndxFLink: LongInt; { Pointer to next link } - IndxCnt: Integer; { Count of Items IN block } - IndxStr: Word; { Offset IN block of 1st str } + IndxCnt: SmallInt; { Count of Items IN block } + IndxStr: SmallWord; { Offset IN block of 1st str } { IF IndxFirst is NOT -1, this is INode: } IndxRef: ARRAY [0..49] OF IndxRefBlk; END; @@ -78,8 +82,8 @@ TYPE IndxFirst, { Pointer to next lower level } IndxBLink, { Pointer to previous link } IndxFLink: LongInt; { Pointer to next link } - IndxCnt: Integer; { Count of Items IN block } - IndxStr: Word; { Offset IN block of 1st str } + IndxCnt: SmallInt; { Count of Items IN block } + IndxStr: SmallWord; { Offset IN block of 1st str } LeafRef: ARRAY [0..49] OF LeafRefBlk; END; @@ -103,7 +107,7 @@ BEGIN END; END; -FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: Word): Boolean; +FUNCTION GetNewAddr(DisplayStr: AStr; MaxLen: Byte; VAR Zone,Net,Node,Point: SmallWord): Boolean; BEGIN GetNewAddr := FALSE; Prt(DisplayStr); @@ -180,7 +184,7 @@ TYPE Zone, Net, Node, - Point: Word; + Point: SmallWord; END; VAR Key: NodeType ABSOLUTE ALine; @@ -205,7 +209,7 @@ BEGIN Compaddress := K; END; -PROCEDURE GetNetAddress(VAR SysOpName:AStr; VAR Zone,Net,Node,Point,Fee:Word; GetFee:Boolean); +PROCEDURE GetNetAddress(VAR SysOpName: AStr; VAR Zone,Net,Node,Point: SmallWord; var Fee: Word; GetFee: Boolean); VAR DataFile, NDXFile: FILE; @@ -249,7 +253,7 @@ VAR Zone, Net, Node, - Point: Word; + Point: SmallWord; END; VAR Address: NodeType; @@ -325,10 +329,10 @@ VAR Zone, { Zone of board } Net, { Net Address of board } Node, { Node Address of board } - Point: Integer; { Either Point number OR 0 } + Point: SmallInt; { Either Point number OR 0 } CallCost, { Cost to sysop to send } MsgFee, { Cost to user to send } - NodeFlags: Word; { Node flags } + NodeFlags: SmallWord; { Node flags } ModemType, { Modem TYPE } PhoneLen, { Length of Phone Number } PassWordLen, { Length of Password } diff --git a/OFFLINE.PAS b/SOURCE/OFFLINE.PAS similarity index 99% rename from OFFLINE.PAS rename to SOURCE/OFFLINE.PAS index 1848f53..a4c9003 100644 --- a/OFFLINE.PAS +++ b/SOURCE/OFFLINE.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S-,V-} UNIT OffLine; @@ -48,7 +52,7 @@ TYPE RNum: STRING[7]; NumBlocks: ARRAY [1..6] OF Char; Status: Byte; - MBase: Word; + MBase: SmallWord; Crap: STRING[3]; END; diff --git a/RECORDS.PAS b/SOURCE/RECORDS.PAS similarity index 95% rename from RECORDS.PAS rename to SOURCE/RECORDS.PAS index b7d8b79..95ae759 100644 --- a/RECORDS.PAS +++ b/SOURCE/RECORDS.PAS @@ -46,6 +46,10 @@ CONST User_Phone_None = ''; {None for user phone fields} TYPE +{$IFDEF MSDOS} + SmallInt = Integer; + SmallWord = Word; +{$ENDIF} AStr = STRING[160]; Str1 = STRING[1]; Str2 = STRING[2]; @@ -165,7 +169,7 @@ TYPE Name: STRING[36]; { the user's name } Number, { user number } Left, { Left node } - Right: Integer; { Right node } + Right: SmallInt; { Right node } RealName, { User's real name? } Deleted: Boolean; { deleted or not } END; @@ -229,11 +233,11 @@ TYPE LastMsgArea, { # last msg area } LastFileArea, { # last file area } UnUsedInteger1, - UnUsedInteger2: Integer; + UnUsedInteger2: SmallInt; PasswordChanged, { Numeric date pw changed - was UnixTime } UnUsedWord1, - UnUsedWord2: Word; + UnUsedWord2: SmallWord; lCredit, { Amount OF credit } Debit, { Amount OF debit } @@ -283,14 +287,14 @@ TYPE FromToInfo = { from/to information for mheaderrec } {$IFDEF WIN32} PACKED {$ENDIF} RECORD Anon: Byte; - UserNum: Word; { user number } + UserNum: SmallWord; { user number } A1S: STRING[36]; { posted as } Real: STRING[36]; { real name } Name: STRING[36]; { system name } Zone, Net, Node, - Point: Word; + Point: SmallWord; END; MHeaderRec = @@ -298,12 +302,12 @@ TYPE From, MTO: FromToInfo; { message from/to info } Pointer: LongInt; { starting record OF text } - TextSize: Word; { size OF text } - ReplyTo: Word; { ORIGINAL + REPLYTO = CURRENT } + TextSize: SmallWord; { size OF text } + ReplyTo: SmallWord; { ORIGINAL + REPLYTO = CURRENT } Date: UnixTime; { date/time PACKED STRING } DayOfWeek: Byte; { message day OF week } Status: SET OF MsgStatusR; { message status flags } - Replies: Word; { times replied to } + Replies: SmallWord; { times replied to } Subject: STRING[40]; { subject OF message } OriginDate: STRING[19]; { date OF echo/group msgs } FileAttached: Byte; { 0=No, 1=Yes&Del, 2=Yes&Save } @@ -337,7 +341,7 @@ TYPE UnArcLine, { de-compression cmdline } TestLine, { integrity test cmdline } CmtLine: STRING[25]; { comment cmdline } - SuccLevel: Integer; { success errorlevel, -1=ignore results } + SuccLevel: SmallInt; { success errorlevel, -1=ignore results } END; ModemFlagType = { MODEM.DAT status flags } @@ -391,7 +395,7 @@ TYPE NewSL, { new SL } NewDSL, { new DSL } NewMenu: Byte; { User start out menu } - Expiration: Word; { days until expiration } + Expiration: SmallWord; { days until expiration } NewFP, { nothing } NewCredit: LongInt; { new credit } SoftAR, { TRUE=AR added to current, else replaces } @@ -526,13 +530,13 @@ TYPE CreditInternetMail, { cost for Internet mail } BirthDateCheck, { check user's birthdate every xx logons } UnUsedInteger1, - UnUsedInteger2: Integer; + UnUsedInteger2: SmallInt; MaxQWKTotal, { max msgs in a packet, period } MaxQWKBase, { max msgs in a area } DaysOnline, { days online } UnUsedWord1, - UnUsedWord2: Word; + UnUsedWord2: SmallWord; MinimumBaud, { minimum baud rate to logon } MinimumDLBaud, { minimum baud rate to download } @@ -614,7 +618,7 @@ TYPE Zone, { 21st is for UUCP address } Net, Node, - Point: Word; + Point: SmallWord; END; NewUserToggles: ARRAY [1..20] OF Byte; @@ -635,7 +639,7 @@ TYPE ShortMessageRecordType = { SHORTMSG.DAT : One-line messages } {$IFDEF WIN32} PACKED {$ENDIF} RECORD Msg: AStr; - Destin: Integer; + Destin: SmallInt; END; VotingRecordType = { VOTING.DAT : Voting records } @@ -644,14 +648,14 @@ TYPE Question2: STRING[60]; { Voting Question 2 } ACS: ACString; { ACS required to vote on this } ChoiceNumber: Byte; { number OF choices } - NumVotedQuestion: Integer; { number OF votes on it } + NumVotedQuestion: SmallInt; { number OF votes on it } CreatedBy: STRING[36]; { who created it } AddAnswersACS: ACString; { ACS required to add choices } Answers: ARRAY [1..25] OF {$IFDEF WIN32} PACKED {$ENDIF} RECORD Answer1, { answer description } Answer2: STRING[65]; { answer description #2 } - NumVotedAnswer: Integer; { # user's who picked this answer } + NumVotedAnswer: SmallInt; { # user's who picked this answer } END; END; @@ -680,11 +684,11 @@ TYPE PostACS, { post access requirement } MCIACS, { MCI usage requirement } SysOpACS: ACString; { Message area sysop requirement } - MaxMsgs: Word; { max message count } + MaxMsgs: SmallWord; { max message count } Anonymous: AnonTyp; { anonymous type } Password: STRING[20]; { area password } MAFlags: MAFlagSet; { message area status vars } - MAType: Integer; { Area type (0=Local,1=Echo, 3=Qwk) } + MAType: SmallInt; { Area type (0=Local,1=Echo, 3=Qwk) } Origin: STRING[50]; { origin line } Text_Color, { color OF standard text } Quote_Color, { color OF quoted text } @@ -695,7 +699,7 @@ TYPE QuoteEnd: STRING[70]; PrePostFile: STRING[8]; AKA: Byte; { alternate address } - QWKIndex: Word; { QWK indexing number } + QWKIndex: SmallWord; { QWK indexing number } END; FileAreaFlagType = @@ -716,7 +720,7 @@ TYPE FileName: STRING[8]; { filename + ".DIR" } DLPath, { download path } ULPath: STRING[40]; { upload path } - MaxFiles: Integer; { max files allowed - VerbRec Limit would allow up to LongInt Value or Maximum 433835} + MaxFiles: SmallInt; { max files allowed - VerbRec Limit would allow up to LongInt Value or Maximum 433835} Password: STRING[20]; { password required } ArcType, { wanted archive type (1..max,0=inactive) } CmtType: Byte; { wanted comment type (1..3,0=inactive) } @@ -742,14 +746,14 @@ TYPE {$IFDEF WIN32} PACKED {$ENDIF} RECORD FileName: STRING[12]; { Filename } Description: STRING[50]; { File description } - FilePoints: Integer; { File points } + FilePoints: SmallInt; { File points } Downloaded: LongInt; { Number DLs } FileSize: LongInt; { File size in Bytes } - OwnerNum: Integer; { ULer OF file } + OwnerNum: SmallInt; { ULer OF file } OwnerName: STRING[36]; { ULer's name } FileDate: UnixTime; { Date ULed } VPointer: LongInt; { Pointer to verbose descr, -1 if none } - VTextSize: Integer; { Verbose descr textsize - 50 Bytes x 99 Lines = 4950 max } + VTextSize: SmallInt; { Verbose descr textsize - 50 Bytes x 99 Lines = 4950 max } FIFlags: FIFlagSet; { File status } END; @@ -770,7 +774,7 @@ TYPE MsgRead, { Messages Read } MsgPost, { Messages Posted } EmailSent, { Email sent } - FeedbackSent: Word; { Feedback sent } + FeedbackSent: SmallWord; { Feedback sent } UK, { Upload/Download kbytes during call } DK: LongInt; Reserved: ARRAY [1..17] OF Byte; { Reserved } @@ -809,7 +813,7 @@ TYPE EventDayOfMonth: BYTE; {If monthly, the Day of Month} EventDays: EventDaysType; {If Daily, the Days Active} EventStartTime, {Start Time in Min from Mid.} - EventFinishTime: WORD; {Finish Time} + EventFinishTime: SmallWord; {Finish Time} EventQualMsg, {Msg/Path if he qualifies} EventNotQualMsg: STRING[64]; {Msg/Path if he doesn't} EventPreTime: BYTE; {Min. B4 event to rest. Call} @@ -820,7 +824,7 @@ TYPE LoBaud, {Low baud rate limit} HiBaud: LongInt; {High baud rate limit} EventACS: ACString; {Event ACS} - MaxTimeAllowed: WORD; {Max Time per user this event} + MaxTimeAllowed: SmallWord; {Max Time per user this event} SetARflag, {AR Flag to Set} ClearARflag: CHAR; {AR Flag to Clear} EFlags: EFlagSet; {Kinds of Events Supported} { Changed } @@ -877,7 +881,7 @@ TYPE NodeRecordType = { MULTNODE.DAT } {$IFDEF WIN32} PACKED {$ENDIF} RECORD - User: Word; { What user number } + User: SmallWord; { What user number } UserName: STRING[36]; { User's name } CityState: STRING[30]; { User's location } Sex: Char; { User's sex } @@ -887,7 +891,7 @@ TYPE ActivityDesc: STRING[50]; { Activity STRING } Status: NodeFlagSet; Room: Byte; { What room are they in? } - Channel: Word; { What channel are they in? } + Channel: SmallWord; { What channel are they in? } Invited, { Have they been invited ? } Booted, { Have they been kicked off ? } Forget: ARRAY [0..31] OF SET OF 0..7; { Who are they forgetting? } @@ -899,7 +903,7 @@ TYPE Anonymous: Boolean; { Is Room anonymous ? } Private: Boolean; { Is Room private ? } Occupied: Boolean; { Is anyone in here? } - Moderator: Word; { Who's the moderator? } + Moderator: SmallWord; { Who's the moderator? } END; ScanRec = { *.SCN files / MESSAGES } diff --git a/RENEGADE.PAS b/SOURCE/RENEGADE.PAS similarity index 98% rename from RENEGADE.PAS rename to SOURCE/RENEGADE.PAS index 9444673..3a2391f 100644 --- a/RENEGADE.PAS +++ b/SOURCE/RENEGADE.PAS @@ -1,4 +1,10 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$IFDEF MSDOS} {$M 35500,0,131072} +{$ENDIF} { R E N E G A D E } { =============== } @@ -226,8 +232,13 @@ END; BEGIN ClrScr; TextColor(Yellow); +{$IFDEF MSDOS} GetIntVec($14,Interrupt14); +{$ENDIF} FileMode := 66; +{$IFDEF WIN32} + FileModeReadWrite := FileMode; +{$ENDIF} ExitSave := ExitProc; ExitProc := @ErrorHandle; @@ -262,6 +273,7 @@ BEGIN ReadP; +{$IFDEF MSDOS} OvrFileMode := 0; Write('Initializing RENEGADE.OVR ... '); OvrInit('RENEGADE.OVR'); @@ -312,6 +324,7 @@ BEGIN END; END; WriteLn('Initial size of the overlay buffer is '+FormatNumber(OvrGetBuf)+' bytes.'); +{$ENDIF} Init; diff --git a/RENEMAIL.PAS b/SOURCE/RENEMAIL.PAS similarity index 95% rename from RENEMAIL.PAS rename to SOURCE/RENEMAIL.PAS index 92a6287..5e89a56 100644 --- a/RENEMAIL.PAS +++ b/SOURCE/RENEMAIL.PAS @@ -1,4 +1,10 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + +{$IFDEF MSDOS} {$M 49152,0,65536} +{$ENDIF} {$A+,I-,E-,F+} PROGRAM ReneMail; @@ -14,7 +20,12 @@ CONST Activity_Log: Boolean = FALSE; NetMailOnly: Boolean = FALSE; IsNetMail: Boolean = FALSE; +{$IFDEF MSDOS} FastPurge: Boolean = TRUE; +{$ENDIF} +{$IFDEF WIN32} + FastPurge: Boolean = FALSE; +{$ENDIF} Process_NetMail: Boolean = TRUE; Purge_NetMail: Boolean = TRUE; Absolute_Scan: Boolean = FALSE; @@ -29,16 +40,16 @@ TYPE ToUserName: STRING[35]; Subject: STRING[71]; DateTime: STRING[19]; - TimesRead: Word; - DestNode: Word; - OrigNode: Word; - Cost: Word; - OrigNet: Word; - DestNet: Word; + TimesRead: SmallWord; + DestNode: SmallWord; + OrigNode: SmallWord; + Cost: SmallWord; + OrigNet: SmallWord; + DestNet: SmallWord; Filler: ARRAY[1..8] OF Char; - ReplyTo: Word; - Attribute: Word; - NextReply: Word; + ReplyTo: SmallWord; + Attribute: SmallWord; + NextReply: SmallWord; END; BufferArrayType = ARRAY[1..32767] OF Char; @@ -62,7 +73,7 @@ VAR FidoFile: FILE; - HiWaterF: FILE OF Word; + HiWaterF: FILE OF SmallWord; General: GeneralRecordType; @@ -76,7 +87,9 @@ VAR FidoMsgHdr: FidoRecordType; +{$IFDEF MSDOS} Regs: Registers; +{$ENDIF} DirInfo: SearchRec; @@ -89,6 +102,51 @@ VAR ParamFound: Boolean; +{$IFDEF WIN32} +(* REENOTE + In BP/TP you can do this: + + var + MySet: NetAttribs; + MyWord: Word; + begin + MySet := [Private, Crash]; + MyWord := Word(MySet); + { MyWord now contains the value 3 in BP/TP } + { but VP refuses to compile the code due to Word(MySet) } + end; + + In VP this typecast isn't allowed (maybe there's a compiler setting to allow it, didn't look actually) + so this function converts from a set to a word type. + + While this function should work for both BP/TP and for VP, I'm only using it for VP and using the + original cast for BP/TP, since there's no need to change what isn't broken +*) +function NetAttribsToWord(inSet: NetAttribs): Word; +var + Result: Word; +begin + Result := 0; + if (Private in inSet) then result := result + 1; + if (Crash in inSet) then result := result + 2; + if (Recd in inSet) then result := result + 4; + if (NSent in inSet) then result := result + 8; + if (FileAttach in inSet) then result := result + 16; + if (Intransit in inSet) then result := result + 32; + if (Orphan in inSet) then result := result + 64; + if (KillSent in inSet) then result := result + 128; + if (Local in inSet) then result := result + 256; + if (Hold in inSet) then result := result + 512; + if (Unused in inSet) then result := result + 1024; + if (FileRequest in inSet) then result := result + 2048; + if (ReturnReceiptRequest in inSet) then result := result + 4096; + if (IsReturnReceipt in inSet) then result := result + 8192; + if (AuditRequest in inSet) then result := result + 16384; + if (FileUpdateRequest in inSet) then result := result + 32768; + NetAttribsToWord := Result; +end; +{$ENDIF} + FUNCTION CenterStr(S: STRING): STRING; VAR Counter1: Byte; @@ -360,6 +418,7 @@ BEGIN END; *) +{$IFDEF MSDOS} FUNCTION AOnOff(B: Boolean; S1,S2: STRING): STRING; ASSEMBLER; ASM PUSH ds @@ -378,6 +437,16 @@ ASM REP MOVSB POP ds END; +{$ENDIF} +{$IFDEF WIN32} +FUNCTION AOnOff(B: Boolean; S1,S2: STRING): STRING; +BEGIN + if (B) then + AOnOff := S1 + else + AOnOff := S2; +END; +{$ENDIF} FUNCTION StripName(S: STRING): STRING; VAR @@ -703,7 +772,7 @@ END; PROCEDURE GetMsgLst(MemMsgPath: STRING; VAR LowMsg,HighMsg: Word); VAR FidoMsgNum, - HiWater: Word; + HiWater: SmallWord; BEGIN HiWater := 1; IF (NOT IsNetMail) THEN @@ -746,7 +815,7 @@ BEGIN LogError(MemMsgPath+'HI_WATER.MRK/Read Record 0 Error - '+IntToStr(LastError)+' (Proc: GetMsgList)'); Exit; END; - FindFirst(MemMsgPath+IntToStr(HiWater)+'.MSG',0,DirInfo); + FindFirst(MemMsgPath+IntToStr(HiWater)+'.MSG',AnyFile,DirInfo); IF (DOSError <> 0) THEN HiWater := 1; END; @@ -763,7 +832,7 @@ BEGIN END; HighMsg := 1; LowMsg := 65535; - FindFirst(MemMsgPath+'*.MSG',0,DirInfo); + FindFirst(MemMsgPath+'*.MSG',AnyFile,DirInfo); WHILE (DOSError = 0) DO BEGIN FidoMsgNum := StrToInt(DirInfo.Name); @@ -781,7 +850,7 @@ BEGIN LowMsg := 2; END; -PROCEDURE UpdateHiWater(MemMsgPath: STRING; HighWater: Word); +PROCEDURE UpdateHiWater(MemMsgPath: STRING; HighWater: SmallWord); BEGIN Assign(HiWaterF,MemMsgPath+'HI_WATER.MRK'); {$I-} ReWrite(HiWaterF); {$I+} @@ -838,16 +907,21 @@ BEGIN FCB[1] := Chr(Ord(MemMsgPath[1]) - 64) ELSE FCB[1] := Chr(Ord(StartDir[1]) - 64); +{$IFDEF MSDOS} Regs.DS := Seg(FCB); Regs.DX := Ofs(FCB); Regs.AX := $1300; MSDOS(Regs); Purged := (Lo(Regs.AX) = 0); +{$ENDIF} +{$IFDEF WIN32} + // We ensure FastPurge is false in Win32, so this is never called +{$ENDIF} END ELSE BEGIN Purged := TRUE; - FindFirst(MemMsgPath+'*.MSG',0,DirInfo); + FindFirst(MemMsgPath+'*.MSG',AnyFile,DirInfo); IF (DOSError <> 0) THEN Purged := FALSE ELSE @@ -1675,7 +1749,12 @@ BEGIN END; IF (IsNetMail) THEN +{$IFDEF MSDOS} FidoMsgHdr.Attribute := Word(RGMsgHdr.NetAttribute) +{$ENDIF} +{$IFDEF WIN32} + FidoMsgHdr.Attribute := NetAttribsToWord(RGMsgHdr.NetAttribute) +{$ENDIF} ELSE IF (Prvt IN RGMsgHdr.Status) THEN FidoMsgHdr.Attribute := 257 ELSE @@ -1967,6 +2046,9 @@ BEGIN GetDir(0,StartDir); FileMode := 66; +{$IFDEF WIN32} + FileModeReadWrite := FileMode; +{$ENDIF} GetGeneral(General); diff --git a/RGLNG.PAS b/SOURCE/RGLNG.PAS similarity index 99% rename from RGLNG.PAS rename to SOURCE/RGLNG.PAS index 707a3d0..7145258 100644 --- a/RGLNG.PAS +++ b/SOURCE/RGLNG.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + PROGRAM RGLNG; USES diff --git a/RGQUOTE.PAS b/SOURCE/RGQUOTE.PAS similarity index 98% rename from RGQUOTE.PAS rename to SOURCE/RGQUOTE.PAS index e007bad..768943b 100644 --- a/RGQUOTE.PAS +++ b/SOURCE/RGQUOTE.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + PROGRAM RGQUOTE; USES diff --git a/SOURCE/RPSCREEN.PAS b/SOURCE/RPSCREEN.PAS new file mode 100644 index 0000000..16aab0d --- /dev/null +++ b/SOURCE/RPSCREEN.PAS @@ -0,0 +1,157 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} +unit RPScreen; + +interface + +{$IFDEF WIN32} +uses + Windows; + +type + TScreenBuf = Array[1..25, 1..80] of TCharInfo; // REETODO Don't hardcode to 80x25 +{$ENDIF} + +procedure RPBlockCursor; +procedure RPGotoXY(xy: SmallWord); +procedure RPHideCursor; +procedure RPInsertCursor; +procedure RPRestoreScreen(var screenBuf: TScreenBuf); +procedure RPSaveScreen(var screenBuf: TScreenBuf); +function RPScreenSizeX: Word; +function RPScreenSizeY: Word; +procedure RPSetAttrAt(x, y, attr: SmallWord); +procedure RPShowCursor; +function RPWhereXY: SmallWord; + +implementation + +{$IFDEF WIN32} +var + StdOut: THandle; +{$ENDIF} + +{$IFDEF WIN32} +procedure RPBlockCursor; +var + CCI: TConsoleCursorInfo; +begin + CCI.bVisible := true; + CCI.dwSize := 15; + SetConsoleCursorInfo(StdOut, CCI); +end; + +procedure RPGotoXY(xy: SmallWord); +var + Coord: TCoord; +begin + Coord.x := xy AND $00FF; + Coord.y := xy AND $FF00 SHR 8; + SetConsoleCursorPosition(StdOut, Coord); +end; + +procedure RPHideCursor; +var + CCI: TConsoleCursorInfo; +begin + GetConsoleCursorInfo(StdOut, CCI); + CCI.bVisible := false; + SetConsoleCursorInfo(StdOut, CCI); +end; + +procedure RPInsertCursor; +var + CCI: TConsoleCursorInfo; +begin + CCI.bVisible := true; + CCI.dwSize := 99; + SetConsoleCursorInfo(StdOut, CCI); +end; + +{ REETODO Should detect screen size } +procedure RPRestoreScreen(var screenBuf: TScreenBuf); +var + BufSize : TCoord; + WritePos : TCoord; + DestRect : TSmallRect; +begin + BufSize.X := 80; + BufSize.Y := 25; + WritePos.X := 0; + WritePos.Y := 0; + DestRect.Left := 0; + DestRect.Top := 0; + DestRect.Right := 79; + DestRect.Bottom := 24; + WriteConsoleOutput(StdOut, @screenBuf[1][1], BufSize, WritePos, DestRect); +end; + +{ REETODO Should detect screen size } +procedure RPSaveScreen(var screenBuf: TScreenBuf); +var + BufSize : TCoord; + ReadPos : TCoord; + SourceRect : TSmallRect; +begin + BufSize.X := 80; + BufSize.Y := 25; + ReadPos.X := 0; + ReadPos.Y := 0; + SourceRect.Left := 0; + SourceRect.Top := 0; + SourceRect.Right := 79; + SourceRect.Bottom := 24; + ReadConsoleOutput(StdOut, @screenBuf[1][1], BufSize, ReadPos, SourceRect); +end; + +function RPScreenSizeX: Word; +var + CSBI: TConsoleScreenBufferInfo; +begin + GetConsoleScreenBufferInfo(StdOut, CSBI); + RPScreenSizeX := CSBI.srWindow.Right - CSBI.srWindow.Left + 1; +end; + +function RPScreenSizeY: Word; +var + CSBI: TConsoleScreenBufferInfo; +begin + GetConsoleScreenBufferInfo(StdOut, CSBI); + RPScreenSizeY := CSBI.srWindow.Bottom - CSBI.srWindow.Top + 1; +end; + +procedure RPSetAttrAt(x, y, attr: SmallWord); +var + NumWritten: Longint; + WriteCoord: TCoord; +begin + WriteCoord.X := x; + WriteCoord.Y := y; + WriteConsoleOutputAttribute(StdOut, @attr, 1, WriteCoord, NumWritten); +end; + +procedure RPShowCursor; +var + CCI: TConsoleCursorInfo; +begin + GetConsoleCursorInfo(StdOut, CCI); + CCI.bVisible := true; + SetConsoleCursorInfo(StdOut, CCI); +end; + +function RPWhereXY: SmallWord; +var + CSBI: TConsoleScreenBufferInfo; +begin + GetConsoleScreenBufferInfo(StdOut, CSBI); + RPWhereXY := CSBI.dwCursorPosition.x + (CSBI.dwCursorPosition.y SHL 8); +end; +{$ENDIF} + + +{$IFDEF WIN32} +BEGIN + StdOut := GetStdHandle(STD_OUTPUT_HANDLE); +{$ENDIF} +END. \ No newline at end of file diff --git a/SCRIPT.PAS b/SOURCE/SCRIPT.PAS similarity index 99% rename from SCRIPT.PAS rename to SOURCE/SCRIPT.PAS index ace124c..1952fde 100644 --- a/SCRIPT.PAS +++ b/SOURCE/SCRIPT.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT Script; diff --git a/SHORTMSG.PAS b/SOURCE/SHORTMSG.PAS similarity index 97% rename from SHORTMSG.PAS rename to SOURCE/SHORTMSG.PAS index 33e2093..e03108b 100644 --- a/SHORTMSG.PAS +++ b/SOURCE/SHORTMSG.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT ShortMsg; diff --git a/SPAWNO.PAS b/SOURCE/SPAWNO.PAS similarity index 73% rename from SPAWNO.PAS rename to SOURCE/SPAWNO.PAS index 1a35111..f6b74fa 100644 --- a/SPAWNO.PAS +++ b/SOURCE/SPAWNO.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + UNIT SPAWNO; INTERFACE @@ -32,11 +36,24 @@ FUNCTION Spawn(ProgName: STRING; Arguments: STRING; EnvSeg: Integer): Integer; IMPLEMENTATION +{$IFDEF MSDOS} {$L SPAWNTP.OBJ} PROCEDURE Init_Spawno(Swap_Dirs: STRING; Swap_Types: Integer; Min_Res: Integer; Res_Stack: Integer); EXTERNAL; FUNCTION Spawn(ProgName: STRING; Arguments: STRING; EnvSeg: Integer): Integer; EXTERNAL; +{$ENDIF} +{$IFDEF WIN32} +PROCEDURE Init_Spawno(Swap_Dirs: STRING; Swap_Types: Integer; Min_Res: Integer; Res_Stack: Integer); +BEGIN + WriteLn('REETODO SPAWNO Init_Spawno'); Halt; +END; + +FUNCTION Spawn(ProgName: STRING; Arguments: STRING; EnvSeg: Integer): Integer; +BEGIN + WriteLn('REETODO SPAWNO Spawn'); Halt; +END; +{$ENDIF} END. diff --git a/SPLITCHA.PAS b/SOURCE/SPLITCHA.PAS similarity index 98% rename from SPLITCHA.PAS rename to SOURCE/SPLITCHA.PAS index 2b14470..a3e6d20 100644 --- a/SPLITCHA.PAS +++ b/SOURCE/SPLITCHA.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SplitCha; @@ -78,10 +82,11 @@ BEGIN lRGLngStr(15,FALSE); IF (OutCom) THEN Com_Send(^G); - IF (ShutUpChatCall) THEN + IF (ShutUpChatCall) THEN Delay(600) ELSE BEGIN + {$IFDEF MSDOS} FOR Counter1 := 300 DOWNTO 2 DO BEGIN Delay(1); @@ -92,8 +97,12 @@ BEGIN Delay(1); Sound(Counter1 * 10); END; + NoSound; +{$ENDIF} +{$IFDEF WIN32} + WriteLn('REETODO SPLITCHA RequestSysOpChat'); Halt; +{$ENDIF} END; - NoSound; IF (KeyPressed) THEN BEGIN Cmd := ReadKey; diff --git a/STATS.PAS b/SOURCE/STATS.PAS similarity index 99% rename from STATS.PAS rename to SOURCE/STATS.PAS index 50c1510..acf8018 100644 --- a/STATS.PAS +++ b/SOURCE/STATS.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT STATS; @@ -8,13 +12,13 @@ USES TYPE Top10UserRecordArray = RECORD - UNum: Integer; + UNum: SmallInt; Info: Real; END; Top20FileRecordArray = RECORD DirNum, - DirRecNum: Integer; + DirRecNum: SmallInt; Downloaded: LongInt; END; diff --git a/SYSOP1.PAS b/SOURCE/SYSOP1.PAS similarity index 99% rename from SYSOP1.PAS rename to SOURCE/SYSOP1.PAS index 7d153bd..f6758a7 100644 --- a/SYSOP1.PAS +++ b/SOURCE/SYSOP1.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp1; @@ -72,7 +76,7 @@ VAR END; END; - PROCEDURE DeleteProtocol(TempProtocol1: ProtocolRecordType; RecNumToDelete: Integer); + PROCEDURE DeleteProtocol(TempProtocol1: ProtocolRecordType; RecNumToDelete: SmallInt); VAR RecNum: Integer; BEGIN @@ -239,7 +243,7 @@ VAR END; PROCEDURE EditProtocol(TempProtocol1: ProtocolRecordType; VAR Protocol: ProtocolRecordType; VAR Cmd1: Char; - VAR RecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); VAR TempStr, CmdStr: AStr; @@ -596,11 +600,11 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertProtocol(TempProtocol1: ProtocolRecordType; RecNumToInsertBefore: Integer); + PROCEDURE InsertProtocol(TempProtocol1: ProtocolRecordType; RecNumToInsertBefore: SmallInt); VAR Cmd1: Char; RecNum, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -655,7 +659,7 @@ VAR END; END; - PROCEDURE ModifyProtocol(TempProtocol1: ProtocolRecordType; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyProtocol(TempProtocol1: ProtocolRecordType; Cmd1: Char; RecNumToEdit: SmallInt); VAR SaveRecNumToEdit: Integer; Ok, @@ -706,11 +710,11 @@ VAR END; END; - PROCEDURE PositionProtocol(TempProtocol1: ProtocolRecordType; RecNumToPosition: Integer); + PROCEDURE PositionProtocol(TempProtocol1: ProtocolRecordType; RecNumToPosition: SmallInt); VAR RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumProtocols = 0) THEN Messages(4,0,'protocols') diff --git a/SYSOP10.PAS b/SOURCE/SYSOP10.PAS similarity index 99% rename from SYSOP10.PAS rename to SOURCE/SYSOP10.PAS index 85777aa..9fa37e3 100644 --- a/SYSOP10.PAS +++ b/SOURCE/SYSOP10.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp10; diff --git a/SYSOP11.PAS b/SOURCE/SYSOP11.PAS similarity index 97% rename from SYSOP11.PAS rename to SOURCE/SYSOP11.PAS index e2bb4bc..932fa84 100644 --- a/SYSOP11.PAS +++ b/SOURCE/SYSOP11.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp11; diff --git a/SYSOP12.PAS b/SOURCE/SYSOP12.PAS similarity index 98% rename from SYSOP12.PAS rename to SOURCE/SYSOP12.PAS index d7332bb..46c9a31 100644 --- a/SYSOP12.PAS +++ b/SOURCE/SYSOP12.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp12; @@ -195,7 +199,7 @@ VAR END; END; - PROCEDURE DeleteConference(TempConference1: ConferenceRecordType; RecNumToDelete: Integer); + PROCEDURE DeleteConference(TempConference1: ConferenceRecordType; RecNumToDelete: SmallInt); VAR User: UserRecordType; RecNum: Integer; @@ -269,7 +273,7 @@ VAR END; PROCEDURE EditConference(TempConference1: ConferenceRecordType; VAR Conference: ConferenceRecordType; VAR Cmd1: Char; - VAR RecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); VAR CmdStr: AStr; Ok: Boolean; @@ -358,11 +362,11 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertConference(TempConference1: ConferenceRecordType; Cmd1: Char; RecNumToInsertBefore: Integer); + PROCEDURE InsertConference(TempConference1: ConferenceRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); VAR OneKCmds: AStr; RecNum, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -427,7 +431,7 @@ VAR END; END; - PROCEDURE ModifyConference(TempConference1: ConferenceRecordType; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyConference(TempConference1: ConferenceRecordType; Cmd1: Char; RecNumToEdit: SmallInt); VAR SaveRecNumToEdit: Integer; Ok, @@ -478,11 +482,11 @@ VAR END; END; - PROCEDURE PositionConference(TempConference1: ConferenceRecordType; RecNumToPosition: Integer); + PROCEDURE PositionConference(TempConference1: ConferenceRecordType; RecNumToPosition: SmallInt); VAR RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumConfKeys = 0) THEN Messages(4,0,'conference records') diff --git a/SYSOP2.PAS b/SOURCE/SYSOP2.PAS similarity index 98% rename from SYSOP2.PAS rename to SOURCE/SYSOP2.PAS index 082abfd..75c1275 100644 --- a/SYSOP2.PAS +++ b/SOURCE/SYSOP2.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2; diff --git a/SYSOP2A.PAS b/SOURCE/SYSOP2A.PAS similarity index 99% rename from SYSOP2A.PAS rename to SOURCE/SYSOP2A.PAS index d5e50a7..99c1a7f 100644 --- a/SYSOP2A.PAS +++ b/SOURCE/SYSOP2A.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp2A; @@ -280,7 +284,7 @@ USES } - PROCEDURE GetTimeRange(CONST RGStrNum: LongInt; VAR LoTime,HiTime: Integer); + PROCEDURE GetTimeRange(CONST RGStrNum: LongInt; VAR LoTime,HiTime: SmallInt); VAR TempStr: Str5; LowTime, diff --git a/SYSOP2B.PAS b/SOURCE/SYSOP2B.PAS similarity index 99% rename from SYSOP2B.PAS rename to SOURCE/SYSOP2B.PAS index 61b2ca8..eeff6f1 100644 --- a/SYSOP2B.PAS +++ b/SOURCE/SYSOP2B.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,L+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp2B; diff --git a/SYSOP2C.PAS b/SOURCE/SYSOP2C.PAS similarity index 99% rename from SYSOP2C.PAS rename to SOURCE/SYSOP2C.PAS index 0dcbd23..0081f3f 100644 --- a/SYSOP2C.PAS +++ b/SOURCE/SYSOP2C.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2C; diff --git a/SYSOP2D.PAS b/SOURCE/SYSOP2D.PAS similarity index 99% rename from SYSOP2D.PAS rename to SOURCE/SYSOP2D.PAS index 1cc5bec..15fdb69 100644 --- a/SYSOP2D.PAS +++ b/SOURCE/SYSOP2D.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2D; @@ -19,7 +23,7 @@ VAR MaxByte: Byte; TempI, MinInt, - MaxInt: Integer; + MaxInt: SmallInt; TempL, MinLongInt, MaxLongInt: LongInt; diff --git a/SYSOP2E.PAS b/SOURCE/SYSOP2E.PAS similarity index 99% rename from SYSOP2E.PAS rename to SOURCE/SYSOP2E.PAS index f1f7044..9fd6ba7 100644 --- a/SYSOP2E.PAS +++ b/SOURCE/SYSOP2E.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} { System Configuration - System Flagged Functions } @@ -22,7 +26,7 @@ VAR Cmd1: Char; LowNum, HiNum, - TempInt: Integer; + TempInt: SmallInt; BEGIN REPEAT WITH General DO diff --git a/SYSOP2F.PAS b/SOURCE/SYSOP2F.PAS similarity index 98% rename from SYSOP2F.PAS rename to SOURCE/SYSOP2F.PAS index 6c78229..4e6acab 100644 --- a/SYSOP2F.PAS +++ b/SOURCE/SYSOP2F.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2F; diff --git a/SYSOP2G.PAS b/SOURCE/SYSOP2G.PAS similarity index 98% rename from SYSOP2G.PAS rename to SOURCE/SYSOP2G.PAS index 3ec2936..ca2451b 100644 --- a/SYSOP2G.PAS +++ b/SOURCE/SYSOP2G.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp2G; @@ -397,7 +401,7 @@ VAR END; END; - PROCEDURE DeleteValidationLevel(TempValidation1: ValidationRecordType; RecNumToDelete: Integer); + PROCEDURE DeleteValidationLevel(TempValidation1: ValidationRecordType; RecNumToDelete: SmallInt); VAR User: UserRecordType; RecNum: Integer; @@ -474,7 +478,7 @@ VAR END; PROCEDURE EditValidationLevel(TempValidation1: ValidationRecordType; VAR Validation: ValidationRecordType; VAR Cmd1: Char; - VAR RecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); VAR User: UserRecordType; CmdStr, @@ -670,11 +674,11 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertValidationLevel(TempValidation1: ValidationRecordType; Cmd1: Char; RecNumToInsertBefore: Integer); + PROCEDURE InsertValidationLevel(TempValidation1: ValidationRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); VAR OneKCmds: AStr; RecNum, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -740,7 +744,7 @@ VAR END; END; - PROCEDURE ModifyValidationLevel(TempValidation1: ValidationRecordType; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyValidationLevel(TempValidation1: ValidationRecordType; Cmd1: Char; RecNumToEdit: SmallInt); VAR SaveRecNumToEdit: Integer; Ok, @@ -791,11 +795,11 @@ VAR END; END; - PROCEDURE PositionValidationLevel(TempValidation1: ValidationRecordType; RecNumToPosition: Integer); + PROCEDURE PositionValidationLevel(TempValidation1: ValidationRecordType; RecNumToPosition: SmallInt); VAR RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumValKeys = 0) THEN Messages(4,0,'validation records') diff --git a/SYSOP2H.PAS b/SOURCE/SYSOP2H.PAS similarity index 99% rename from SYSOP2H.PAS rename to SOURCE/SYSOP2H.PAS index 45c03ab..4dd3acf 100644 --- a/SYSOP2H.PAS +++ b/SOURCE/SYSOP2H.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp2H; diff --git a/SYSOP2I.PAS b/SOURCE/SYSOP2I.PAS similarity index 98% rename from SYSOP2I.PAS rename to SOURCE/SYSOP2I.PAS index df7d5aa..5366472 100644 --- a/SYSOP2I.PAS +++ b/SOURCE/SYSOP2I.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2I; diff --git a/SYSOP2J.PAS b/SOURCE/SYSOP2J.PAS similarity index 99% rename from SYSOP2J.PAS rename to SOURCE/SYSOP2J.PAS index aef628e..b4c18ef 100644 --- a/SYSOP2J.PAS +++ b/SOURCE/SYSOP2J.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp2J; @@ -367,7 +371,7 @@ VAR END; END; - PROCEDURE DeleteScheme(TempScheme1: SchemeRec; RecNumToDelete: Integer); + PROCEDURE DeleteScheme(TempScheme1: SchemeRec; RecNumToDelete: SmallInt); VAR User: UserRecordType; RecNum: Integer; @@ -446,7 +450,7 @@ VAR END; PROCEDURE EditScheme(TempScheme1: SchemeRec; VAR Scheme: SchemeRec; VAR Cmd1: Char; - VAR RecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); VAR CmdStr: AStr; Ok: Boolean; @@ -543,11 +547,11 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToInsertBefore: Integer); + PROCEDURE InsertScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToInsertBefore: SmallInt); VAR User: UserRecordType; RecNum, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -618,7 +622,7 @@ VAR END; END; - PROCEDURE ModifyScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyScheme(TempScheme1: SchemeRec; Cmd1: Char; RecNumToEdit: SmallInt); VAR SaveRecNumToEdit: Integer; Ok, @@ -674,7 +678,7 @@ VAR RecNumToPosition, RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumSchemes = 0) THEN Messages(4,0,'color schemes') diff --git a/SYSOP2K.PAS b/SOURCE/SYSOP2K.PAS similarity index 99% rename from SYSOP2K.PAS rename to SOURCE/SYSOP2K.PAS index 3e7ba0f..0339b04 100644 --- a/SYSOP2K.PAS +++ b/SOURCE/SYSOP2K.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp2K; diff --git a/SYSOP2L.PAS b/SOURCE/SYSOP2L.PAS similarity index 97% rename from SYSOP2L.PAS rename to SOURCE/SYSOP2L.PAS index e22e606..9fae3ba 100644 --- a/SYSOP2L.PAS +++ b/SOURCE/SYSOP2L.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2L; diff --git a/SYSOP2M.PAS b/SOURCE/SYSOP2M.PAS similarity index 99% rename from SYSOP2M.PAS rename to SOURCE/SYSOP2M.PAS index e90f03d..7bdc7b4 100644 --- a/SYSOP2M.PAS +++ b/SOURCE/SYSOP2M.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2M; diff --git a/SYSOP2O.PAS b/SOURCE/SYSOP2O.PAS similarity index 97% rename from SYSOP2O.PAS rename to SOURCE/SYSOP2O.PAS index f1be26b..204250f 100644 --- a/SYSOP2O.PAS +++ b/SOURCE/SYSOP2O.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT SysOp2O; @@ -17,7 +21,7 @@ VAR Counter: Byte; DisplayValue, FromValue, - ToValue: Integer; + ToValue: SmallInt; NewValue: LongInt; PROCEDURE ShowSecRange(Start: Byte); diff --git a/SYSOP3.PAS b/SOURCE/SYSOP3.PAS similarity index 99% rename from SYSOP3.PAS rename to SOURCE/SYSOP3.PAS index 067fe38..5fc4558 100644 --- a/SYSOP3.PAS +++ b/SOURCE/SYSOP3.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp3; diff --git a/SYSOP4.PAS b/SOURCE/SYSOP4.PAS similarity index 97% rename from SYSOP4.PAS rename to SOURCE/SYSOP4.PAS index bf75a26..80cfc35 100644 --- a/SYSOP4.PAS +++ b/SOURCE/SYSOP4.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S-,V-} UNIT SysOp4; @@ -219,7 +223,12 @@ VAR END; BEGIN +{$IFDEF MSDOS} Mark(TopHeap); +{$ENDIF} +{$IFDEF WIN32} + // REETODO Prepare to leak memory... +{$ENDIF} Used := NIL; Top := NIL; Bottom := NIL; @@ -392,7 +401,12 @@ BEGIN Cur := NIL; Top := NIL; Bottom := NIL; +{$IFDEF MSDOS} Release(TopHeap); +{$ENDIF} +{$IFDEF WIN32} + // REETODO Likely going to leak memory right about now +{$ENDIF} END; 'D' : BEGIN I := StrToInt(Copy(S,2,9)); @@ -536,7 +550,12 @@ BEGIN UNTIL ((Done) OR (HangUp)); END; END; +{$IFDEF MSDOS} Release(TopHeap); +{$ENDIF} +{$IFDEF WIN32} + // REETODO Likely going to leak memory right about now +{$ENDIF} PrintingFile := FALSE; LastError := IOResult; END; diff --git a/SYSOP5.PAS b/SOURCE/SYSOP5.PAS similarity index 97% rename from SYSOP5.PAS rename to SOURCE/SYSOP5.PAS index acc8b5d..2c6241d 100644 --- a/SYSOP5.PAS +++ b/SOURCE/SYSOP5.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp5; @@ -49,7 +53,7 @@ VAR END; PROCEDURE LocateHistoryDate(DisplayStr: AStr; TempHistory1: HistoryRecordType; VAR DateToLocate: Str10; - VAR RecNum1: Integer; ShowErr,Searching: Boolean); + VAR RecNum1: SmallInt; ShowErr,Searching: Boolean); VAR RecNum: Integer; BEGIN @@ -78,7 +82,7 @@ VAR END; END; - PROCEDURE DeleteHistoryRecord(TempHistory1: HistoryRecordType; RecNumToDelete: Integer); + PROCEDURE DeleteHistoryRecord(TempHistory1: HistoryRecordType; RecNumToDelete: SmallInt); VAR DateToDelete: Str10; RecNum: Integer; @@ -139,12 +143,12 @@ VAR END; PROCEDURE EditHistoryRecord(TempHistory1: HistoryRecordType; VAR History: HistoryRecordType; VAR Cmd1: Char; - VAR RecNumToEdit,SaveRecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit,SaveRecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); VAR CmdStr, TempStr1: AStr; DateToLocate: Str10; - RecNum: Integer; + RecNum: SmallInt; Ok: Boolean; BEGIN WITH History DO @@ -333,13 +337,13 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertHistoryRecord(TempHistory1: HistoryRecordType; Cmd1: Char; RecNumToInsertBefore: Integer); + PROCEDURE InsertHistoryRecord(TempHistory1: HistoryRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); VAR DateToInsert, DateToInsertBefore: Str10; RecNum, RecNum1, - SaveRecNumToEdit: Integer; + SaveRecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -410,10 +414,10 @@ VAR END; END; - PROCEDURE ModifyHistoryRecord(TempHistory1: HistoryRecordType; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyHistoryRecord(TempHistory1: HistoryRecordType; Cmd1: Char; RecNumToEdit: SmallInt); VAR DateToEdit: Str10; - SaveRecNumToEdit: Integer; + SaveRecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN diff --git a/SYSOP6.PAS b/SOURCE/SYSOP6.PAS similarity index 99% rename from SYSOP6.PAS rename to SOURCE/SYSOP6.PAS index ef1501d..0e93253 100644 --- a/SYSOP6.PAS +++ b/SOURCE/SYSOP6.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp6; @@ -133,7 +137,7 @@ VAR END; END; - PROCEDURE DeleteEvent(TempEvent1: EventRecordType; RecNumToDelete: Integer); + PROCEDURE DeleteEvent(TempEvent1: EventRecordType; RecNumToDelete: SmallInt); VAR RecNum: Integer; BEGIN @@ -188,7 +192,7 @@ VAR PROCEDURE EditEvent(TempEvent1: EventRecordType; VAR Event: EventRecordType; VAR Cmd1: Char; - VAR RecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); CONST BaudRates: ARRAY [1..20] OF LongInt = (300,600,1200,2400,4800,7200,9600, 12000,14400,16800,19200,21600,24000, @@ -746,10 +750,10 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertEvent(TempEvent1: EventRecordType; Cmd1: Char; RecNumToInsertBefore: Integer); + PROCEDURE InsertEvent(TempEvent1: EventRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); VAR RecNum, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -804,7 +808,7 @@ VAR END; END; - PROCEDURE ModifyEvent(TempEvent1: EventRecordType; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyEvent(TempEvent1: EventRecordType; Cmd1: Char; RecNumToEdit: SmallInt); VAR SaveRecNumToEdit: Integer; Ok, @@ -855,11 +859,11 @@ VAR END; END; - PROCEDURE PositionEvent(TempEvent1: EventRecordType; RecNumToPosition: Integer); + PROCEDURE PositionEvent(TempEvent1: EventRecordType; RecNumToPosition: SmallInt); VAR RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumEvents = 0) THEN Messages(4,0,'events') diff --git a/SYSOP7.PAS b/SOURCE/SYSOP7.PAS similarity index 99% rename from SYSOP7.PAS rename to SOURCE/SYSOP7.PAS index 62e4efa..2c9cd55 100644 --- a/SYSOP7.PAS +++ b/SOURCE/SYSOP7.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B+,D+,E+,F+,I+,L+,N-,O+,R-,S+,V-} UNIT SysOp7; @@ -227,7 +231,7 @@ VAR PROCEDURE DeleteMenu; VAR RecNumToDelete, - RecNum: Integer; + RecNum: SmallInt; DeleteOk: Boolean; BEGIN IF (NumMenus = 0) THEN @@ -303,7 +307,7 @@ VAR VAR RecNumToInsertBefore, NewMenuNum, - RecNum: Integer; + RecNum: SmallInt; BEGIN IF (NumMenus = MaxMenus) THEN Messages(5,MaxMenus,'menus') @@ -363,7 +367,7 @@ VAR RecNum, RecNum1, RecNumToModify, - SaveRecNumToModify: Integer; + SaveRecNumToModify: SmallInt; Changed: Boolean; BEGIN IF (NumMenus = 0) THEN diff --git a/SYSOP7M.PAS b/SOURCE/SYSOP7M.PAS similarity index 99% rename from SYSOP7M.PAS rename to SOURCE/SYSOP7M.PAS index bf12f71..3af822c 100644 --- a/SYSOP7M.PAS +++ b/SOURCE/SYSOP7M.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B+,D+,E+,F+,I+,L+,N-,O+,R-,S+,V-} UNIT SysOp7M; @@ -117,7 +121,7 @@ VAR PROCEDURE DeleteCommand; VAR RecNumToDelete, - RecNum: Integer; + RecNum: SmallInt; BEGIN IF (CmdNumArray[MenuToModify] = 0) THEN Messages(4,0,'commands') @@ -156,7 +160,7 @@ VAR VAR RecNumToInsertBefore, InsertNum, - RecNum: Integer; + RecNum: SmallInt; BEGIN IF (CmdNumArray[MenuToModify] = MaxCmds) THEN Messages(5,MaxCmds,'commands') @@ -204,7 +208,7 @@ VAR Cmd1: Char; TempB: Byte; RecNumToModify, - SaveRecNumToModify: Integer; + SaveRecNumToModify: SmallInt; Changed: Boolean; BEGIN IF (CmdNumArray[MenuToModify] = 0) THEN @@ -355,7 +359,7 @@ VAR RecNumToPosition, RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (CmdNumArray[MenuToModify] = 0) THEN Messages(4,0,'commands') diff --git a/SYSOP8.PAS b/SOURCE/SYSOP8.PAS similarity index 98% rename from SYSOP8.PAS rename to SOURCE/SYSOP8.PAS index 9236049..5b7faa1 100644 --- a/SYSOP8.PAS +++ b/SOURCE/SYSOP8.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp8; @@ -21,7 +25,7 @@ VAR MsgareaDefFile: FILE OF MessageAreaRecordType; TempMemMsgArea: MessageAreaRecordType; Cmd: Char; - RecNumToList: Integer; + RecNumToList: SmallInt; Ok, Changed, SaveTempPause: Boolean; @@ -159,10 +163,10 @@ VAR END; END; - PROCEDURE ChangeMsgAreaDrive(Drive: Char; FirstRecNum: Integer); + PROCEDURE ChangeMsgAreaDrive(Drive: Char; FirstRecNum: SmallInt); VAR LastRecNum, - RecNum: Integer; + RecNum: SmallInt; BEGIN IF (NumMsgAreas = 0) THEN Messages(4,0,'message areas') @@ -209,7 +213,7 @@ VAR END END; - PROCEDURE DeleteMsgArea(TempMemMsgArea1: MessageAreaRecordType; RecNumToDelete: Integer); + PROCEDURE DeleteMsgArea(TempMemMsgArea1: MessageAreaRecordType; RecNumToDelete: SmallInt); VAR RecNum: Integer; Ok, @@ -311,7 +315,7 @@ VAR END; PROCEDURE EditMessageArea(TempMemMsgArea1: MessageAreaRecordType; VAR MemMsgArea: MessageAreaRecordType; VAR Cmd1: Char; - VAR RecNumToEdit: Integer; VAR Changed: Boolean; Editing: Boolean); + VAR RecNumToEdit: SmallInt; VAR Changed: Boolean; Editing: Boolean); VAR TempFileName: Str8; Path1, @@ -683,12 +687,12 @@ VAR UNTIL (Pos(Cmd1,'Q[]FJL') <> 0) OR (HangUp); END; - PROCEDURE InsertMsgArea(TempMemMsgArea1: MessageAreaRecordType; Cmd1: Char; RecNumToInsertBefore: Integer); + PROCEDURE InsertMsgArea(TempMemMsgArea1: MessageAreaRecordType; Cmd1: Char; RecNumToInsertBefore: SmallInt); VAR MsgAreaScanFile: FILE OF ScanRec; RecNum, RecNum1, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; Ok, Changed: Boolean; BEGIN @@ -788,7 +792,7 @@ VAR END; END; - PROCEDURE ModifyMsgArea(TempMemMsgArea1: MessageAreaRecordType; Cmd1: Char; RecNumToEdit: Integer); + PROCEDURE ModifyMsgArea(TempMemMsgArea1: MessageAreaRecordType; Cmd1: Char; RecNumToEdit: SmallInt); VAR User: UserRecordType; MsgAreaScanFile: FILE OF ScanRec; @@ -912,11 +916,11 @@ VAR END; END; - PROCEDURE PositionMsgArea(TempMemMsgArea1: MessageAreaRecordType; RecNumToPosition: Integer); + PROCEDURE PositionMsgArea(TempMemMsgArea1: MessageAreaRecordType; RecNumToPosition: SmallInt); VAR RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumMsgAreas = 0) THEN Messages(4,0,'message areas') @@ -1016,7 +1020,7 @@ VAR END; END; - PROCEDURE ListMsgAreas(VAR RecNumToList1: Integer); + PROCEDURE ListMsgAreas(VAR RecNumToList1: SmallInt); VAR NumDone: Integer; BEGIN diff --git a/SYSOP9.PAS b/SOURCE/SYSOP9.PAS similarity index 99% rename from SYSOP9.PAS rename to SOURCE/SYSOP9.PAS index eb98404..45f7ed8 100644 --- a/SYSOP9.PAS +++ b/SOURCE/SYSOP9.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT SysOp9; @@ -21,7 +25,7 @@ TYPE Drive: Char; FirstRecNum, LastRecNum, - RecNumToEdit: Integer; + RecNumToEdit: SmallInt; END; CONST @@ -347,7 +351,7 @@ VAR PROCEDURE DeleteFileArea(TempMemFileArea1: FileAreaRecordType; MCIVars1: MCIVarRecord); VAR RecNum, - RecNumToDelete: Integer; + RecNumToDelete: SmallInt; Ok, OK1, Ok2: Boolean; @@ -866,7 +870,7 @@ VAR Cmd1: Char; RecNum, RecNum1, - RecNumToInsertBefore: Integer; + RecNumToInsertBefore: SmallInt; Ok, Changed: Boolean; BEGIN @@ -1098,7 +1102,7 @@ VAR RecNumToPosition, RecNumToPositionBefore, RecNum1, - RecNum2: Integer; + RecNum2: SmallInt; BEGIN IF (NumFileAreas = 0) THEN FAELngStr(5,MemFileArea,MCIVars1,FALSE) diff --git a/TAGLINE.PAS b/SOURCE/TAGLINE.PAS similarity index 98% rename from TAGLINE.PAS rename to SOURCE/TAGLINE.PAS index cce8de6..2672772 100644 --- a/TAGLINE.PAS +++ b/SOURCE/TAGLINE.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + PROGRAM TAGLINE; USES diff --git a/TIMEBANK.PAS b/SOURCE/TIMEBANK.PAS similarity index 99% rename from TIMEBANK.PAS rename to SOURCE/TIMEBANK.PAS index 0529ccd..0ffd8be 100644 --- a/TIMEBANK.PAS +++ b/SOURCE/TIMEBANK.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT TimeBank; diff --git a/TIMEFUNC.PAS b/SOURCE/TIMEFUNC.PAS similarity index 99% rename from TIMEFUNC.PAS rename to SOURCE/TIMEFUNC.PAS index b107fbb..cc6f551 100644 --- a/TIMEFUNC.PAS +++ b/SOURCE/TIMEFUNC.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D-,E-,F+,I-,L-,N-,O+,R-,S+,V-} UNIT TimeFunc; 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.PAS b/SOURCE/UNUSED/RGMAIN.PAS similarity index 98% rename from RGMAIN.PAS rename to SOURCE/UNUSED/RGMAIN.PAS index ba5ee80..8c9dbad 100644 --- a/RGMAIN.PAS +++ b/SOURCE/UNUSED/RGMAIN.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + PROGRAM RGMAIN; USES 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.PAS b/SOURCE/UNUSED/RGNOTE.PAS similarity index 99% rename from RGNOTE.PAS rename to SOURCE/UNUSED/RGNOTE.PAS index 42b30aa..1a29748 100644 --- a/RGNOTE.PAS +++ b/SOURCE/UNUSED/RGNOTE.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + PROGRAM RGNOTE; USES 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.PAS b/SOURCE/UNUSED/RGSCFG.PAS similarity index 99% rename from RGSCFG.PAS rename to SOURCE/UNUSED/RGSCFG.PAS index 10a1379..f0c47cc 100644 --- a/RGSCFG.PAS +++ b/SOURCE/UNUSED/RGSCFG.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + PROGRAM RGMAIN; USES 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 99% rename from VOTE.PAS rename to SOURCE/VOTE.PAS index 94b1bf4..c2dac62 100644 --- a/VOTE.PAS +++ b/SOURCE/VOTE.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT Vote; diff --git a/WFCMENU.PAS b/SOURCE/WFCMENU.PAS similarity index 98% rename from WFCMENU.PAS rename to SOURCE/WFCMENU.PAS index 6eb5910..cbbdc15 100644 --- a/WFCMENU.PAS +++ b/SOURCE/WFCMENU.PAS @@ -1,3 +1,7 @@ +{$IFDEF WIN32} +{$I DEFINES.INC} +{$ENDIF} + {$A+,B-,D+,E-,F+,I-,L+,N-,O+,R-,S+,V-} UNIT WFCMenu; @@ -43,7 +47,11 @@ USES SysOp11, SysOp12, TimeFunc, - MiscUser; + MiscUser +{$IFDEF WIN32} + ,Windows +{$ENDIF} + ; VAR LastKeyPress: LongInt; @@ -305,7 +313,12 @@ BEGIN Com_Send_Str(Liner.Answer); IF (SysOpOn) THEN +{$IFDEF MSDOS} Update_Logo(ANSWER,ScreenAddr[(3*2)+(19*160)-162],ANSWER_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(ANSWER, 3, 19, ANSWER_LENGTH); +{$ENDIF} rl := 0; SaveTimer := Timer; @@ -412,10 +425,19 @@ BEGIN IF (SysOpOn) THEN BEGIN +{$IFDEF MSDOS} Update_Logo(WFC,ScreenAddr[0],WFC_LENGTH); - +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(WFC, 1, 1, WFC_LENGTH); +{$ENDIF} IF (General.NetworkMode) THEN +{$IFDEF MSDOS} Update_Logo(WFCNET,ScreenAddr[(3*2)+(19*160)-162],WFCNET_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(WFCNET, 3, 19, WFCNET_LENGTH); +{$ENDIF} LoadURec(ThisUser,1); @@ -585,7 +607,12 @@ BEGIN END; END ELSE +{$IFDEF MSDOS} Update_Logo(WFC0,ScreenAddr[0],WFC0_LENGTH); +{$ENDIF} +{$IFDEF WIN32} + Update_Logo(WFC0, 1, 1, WFC0_LENGTH); +{$ENDIF} END; END; @@ -710,6 +737,7 @@ VAR BeepEnd := FALSE; rl := Timer; REPEAT +{$IFDEF MSDOS} Sound(1500); Delay(20); Sound(1000); @@ -717,6 +745,10 @@ VAR Sound(800); Delay(20); NoSound; +{$ENDIF} +{$IFDEF WIN32} + Sound(1000, 60); +{$ENDIF} rl1 := Timer; WHILE (ABS(rl1 - Timer) < 0.9) AND (NOT KeyPressed) DO; UNTIL (ABS(rl - Timer) > 30) OR (KeyPressed); @@ -918,9 +950,14 @@ BEGIN DailyMaint; +{$IFDEF MSDOS} ASM Int 28h END; +{$ENDIF} +{$IFDEF WIN32} + Sleep(1); +{$ENDIF} IF (AnswerBaud = 0) THEN BEGIN diff --git a/SOURCE/WIN32/defines.inc b/SOURCE/WIN32/defines.inc new file mode 100644 index 0000000..397b28e --- /dev/null +++ b/SOURCE/WIN32/defines.inc @@ -0,0 +1,7 @@ +{$IFDEF VPASCAL} + {&AlignRec-} + {&Delphi-} + {&Use32+} + {$H-} + {$V-} +{$ENDIF} \ No newline at end of file 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..a759605 --- /dev/null +++ b/VPC.CFG @@ -0,0 +1,25 @@ +/OZ:\PROGRA~1\RG119SRC\EXE\VP +/I.\ELECOM;.\WIN32;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;.\WIN32;Z:\VP21\LIB.W32;Z:\VP21\UNITS.W32 +/R.\ELECOM;.\WIN32;Z:\VP21\RES.W32 +/$A+ +/$B- +/$D+ +/$E+ +/$F+ +/$G+ +/$I- +/$L+ +/$N- +/$O+ +/$P- +/$Q- +/$R- +/$S- +/$T- +/$V- +/$X+ +/$Y+ +/B +/GD